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LE BASIC ET SES FICHIERS 


PRESENTATION 


Pour la plupart, les programmes présentés sont à vocation 
professionnelle. Comme pour le volume 1, ils concernent les 
matériels disposant du BASIC MICROSOFT : TRS-80 et systèmes 
fonctionnant sous CPM. 


Cet ouvrage fera gagner un temps appréciable à tous ceux 
qui doivent assurer une gestion en "temps réel" de leurs 
fichiers ; les méthodes d'accès par clé (Hash-Code et Accès 
Indexé) déjà abordées dans le volume 1 y sont traitées de 
façon plus approfondie. 


Vous sont également proposés un générateur de saisie d'écran 
qui mettra en valeur vos programmes, un tri rapide, ainsi que 
de nombreux programmes ‘"types' en gestion : édition automati- 
que, interrogation de fichier, etc... 


Structurés et commentés, ces programmes seront aisément 
adaptables à vos problèmes. 
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CHAPITRE 1 
LES FICHIERS A ACCES DIRECT 


RAPPELS SUR LES FICHIERS A ACCES DIRECT 


Les fichiers à accès direct considérés sont ceux du Basic 
Microsoft. Un fichier à accès direct (RANDOM) est une collec- 
tion d'enregistrements de même longueur repérés par un numéro 
(1,2,3,...). La longueur de ceux-ci est soit fixée par le 
système (256 pour le TRS-80), soit choisie par l'utilisateur 
au moment de l'ouverture du fichier (MICROSOFT 5.). 


[1 OUVERTURE DU FICHIER par OPEN 
C1 DESCRIPTION DES ZONES DE LA MEMOIRE TAMPON PAR FIELD#,.. 


C2 REMPLISSAGE DES ZONES par LSET-RSET 


#enreg [ecran | ECRAN VERT 24 LIGNES [so00 fpoco roc MEMOIRE TAMPON 


a la fois 2 (BUFFER) 
4/ ECRITURE LECTURE 
PUT À GET # 
REF$ LIB$ PACHA$ 
FICHIER 


DISQUE | DISQUE 5 MEGA OCTETS 30000 [40000 [xxxxxx 


CLAVIERŸ CLAVIER AZERTY 


256 caracteres pour TRS80 
variables pour MICROSOFT 5. 
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OUVERTURE D'UN FICHIER : OPEN #numéro fichier,"R","nom du 
fichier" 


Précisons d'abord que pour accéder à un fichier, il faut 
l'ouvrir par une instruction "OPEN' 


60 OPEN 'R',1,"STOCK" 
R spécifie le type de fichier (RANDOM) 


1 représente un numéro choisi par le programmeur. Ce numéro 
servira dans la suite du programme à référencer le fichier 
"STOCK". 


L'ouverture réserve une mémoire tampon (en mémoire centrale) 
où transiteront les informations du fichier. 


Un fichier 'RANDOM' (aléatoire) est composé d'enregistre- 
ments référencés par un numéro (1 à 32000 par exemple). 


Chacun de ces enregistrements correspond par exemple à une 
fiche client ou produit d'un fichier manuel. 


TRS-80 : + OPEN "R",#1,"STCK:1" " unité de disque 1 
. Numéros autorisés:1-355 
. Longueur fixe: 256 octets 


MICROSOFT 5.:. OPEN "R",#1,"B:STCK",50 "50:longueur des 
enregistrements 
. Numéros autorisés:1-32000 
. Longueur des enregistrements variable 


FORMAT DES ENREGISTREMENTS : FIELD #numéro fichier, longueurl 
AS zonel,longueur2 AS zone2,... 


Un enregistrement est découpé en ‘'zones' (ou champs). Ainsi 
pour un enregistrement concernant un produit, nous avons 
différentes zones telles que la référence, le prix, le stock, 
etc. 


La définition de la longueur des zones et de leur type est 
faite par une instruction ‘FIELD' 


80 FIELD #1,12 AS REF$,25 AS LIB$,4 AS PACHA$,4 AS PVENTES,.. 


12 caractères sont réservés pour la référence 
25 caractères sont réservés pour le libellé 
4 caractères sont réservés pour le prix d'achat 


Nous verrons plus loin que plusieurs FIELD# peuvent être 
définis simultanément pour un même fichier. 


LECTURE D'UN ENREGISTREMENT DEJA CREE : GET #numéro fichier, 
numéro enregistrement 


La lecture en mémoire centrale d'un enregistrement déjà 
existant se fait par : 


510 INPUT "Quel enregistrement? ";NE 
520 GET #1,NE * NE : Adresse de rangement 
530 PRINT REF$,LIB$ ‘ Edition des zones REF$ et LIB$ 


Toutes les zones pour l'enregistrement lu peuvent alors être 
traitées (imprimées sur l'exemple). 
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CREATION D'ENREGISTREMENTS : PUT #numéro fichier, numéro 
enregistrement 


Le transfert d'informations dans un fichier se fait par 
l'intermédiaire d'une mémoire tampon (buffer). 


Les instructions LSET et RSET permettent de documenter les 
zones définies dans l'instruction FIELD#. 


720 INPUT "Libelle? ";X$ 
730 LSET LIB$=X$ " Affecte a LIB$ la valeur de X$ 


LSET transfère la valeur de X$ (entrée par INPUT) dans la zone 
LIBg de la mémoire en cadrant à gauche, d'où le L (left) de 
LSET, RSET cadre à droite (Right). 


Si 25 caractères ont été prévus pour la zone LIBS et que le 
libellé a une longueur de 15, les 10 positions inoccupées à 
droite de LIBS sont complétées par des espaces. IL est inter- 
dit de faire directement INPUT "Libellé ? ";LIBS. 


Lorsque les valeurs des différentes zones définies dans FIELD 
ont été affectées, le transfert de la mémoire tampon dans le 
fichier sur disque se fait par : 


570 PUT #H1,NE ‘Ecriture dans l'enregistrement de numéro NE 


où #1 représente le numéro de fichier défini à l'ouverture et 
NE l'adresse où est rangé l'enregistrement. 


Le rangement d'un nouvel article se fait généralement en 
utilisant la fonction LOF (numéro fichier) qui fournit le 
nombre d'enregistrements d'un fichier. On fait donc le range- 
ment en LOF(1)+1. 


660 NE =LOF(1)+1 " initialisation de la memoire tampon 

670 GET #1,NE " avec des valeurs ASCII nulles 

690 INPUT "Reference? ";X$ 

710 LSET REF$=X$ ‘ Remplissage de la zone REF$ 

820 PUT #1,NE " Ecriture dans le fichier 
L'instruction GET #1,NE (sachant que NE =LOF(1)+1) lit 


dans la mémoire tampon (buffer) l'enregistrement de numéro 

NE contenant des valeurs ASCII nulles et initialise ainsi 
les différentes zones définies dans FIELD# avec des valeurs 
ASCII nulles. Ceci afin d'éviter qu'au moment de l'écriture 
par PUT #, les zones, à qui il n'aurait pas été affecté de 
valeur à la saisie aient celles de l'enregistrement précédem- 
ment traité (en lecture ou écriture). 


Un fichier n'est pas une table, on ne dispose, en mémoire 
centrale, que d'un enregistrement à la fois. 


Remarque : l'initialisation de la mémoire tampon peut égale- 
ment être programmée ainsi : (MICROSOFT 5.) 


10 FIELD #1,128 AS X$ 
20 FIELD #1,15 AS REF$,25 AS LIB$,.... 


100 LSET X$=STRING$(CHR$(0),128) 


LL 
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Erreur à ne pas commettre: il est interdit d'affecter directe- 
ment une valeur à une variable définie dans FIELD # sans 
utiliser LSET ou RSET : 


INPUT "Référence? ";REFS ‘Interdit 


La variable REF$ se trouverait désalouée de la mémoire tampon 
et serait considérée dans la suite du programme comme une 
variable normale. 


DIFFERENTS TYPES DE ZONES 


Les valeurs numériques font l'objet d'un traitement parti- 
culier : elles sont en effet compactées sur disque sous forme 
de chaînes de caractères. 


Par exemple, des nombres entiers compris entre -32000 et 
+32000 ne nécessitent que 2 octets. Les types de zones ne sont 
pas définis explicitement dans l'instruction FIELD. 


C'est par une instruction de conversion au moment du LSET 
que le compactage s'effectue. 


LSET QVENDUS=MKIS (X) ‘Compacte X sur 2 octets 


La place réservée dans FIELD# pour QVENDUS doit être de 2 
octets. 


À la lecture, la conversion inverse doit être effectuée par 
X=CVI (QVENDUS), (PRINT QVENDUS n'aurait pas de signification). 


Suivant les types de variables numériques, les conversions 
se font par : 


ECRITURE LECTURE 


MKIS CVI —32768<entiersé+32767 2 octets réservés 
dans FIELD 

MKSg CVS simple précision 4 octets réservés 
dans FIELD 

MKDÿ CVD double précision 8 octets 

CHR$ ASC O<entiers<255 1 octet 


SUPPRESSION D'ENREGISTREMENTS 


La suppression d'enregistrements n'existe pas explicitement. 
Le plus simple est de placer des valeurs ASCII nulles à l'in- 
térieur de l'enregistrement à supprimer. 


Ces valeurs nulles permettront plus tard de repérer les 
enregistrements inutilisés. 


GET #1,LOF(1)+1 ‘Remplissage de la mémoire 
tampon avec zéros ASCII 
PUT #1, numéro à supprimer 


La place disque de l'enregistrement supprimé n'est pas récupérée. 


FIN DE FICHIER : LOF (numéro fichier) 


TRS-80 : la fonction LOF permet, sur TRS-80, de connaître le 
numéro du dernier enregistrement d'un fichier (le 
numéro le plus élevé). 


MICROSOFT 5.: La fonction LOF n'a plus le même sens et n'a 
guère d'utilité, elle représente en effet le 
nombre de blocs de 128 octets utilisés dans le 
dernier extent référencé (1 extent=128X128 octets). 
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Il faut donc gérer soi-même un compteur d'enregistrements 
ou mieux assurer l'allocation dynamique des enregistrements 
(cf. HASH-CODE et allocation dynamique). 


FERMETURE DE FICHIER : CLOSE #numéro fichier 


L'instruction CLOSE libère la mémoire tampon du fichier 
clos. 


Le bloc de contrôle du fichier amené en mémoire centrale à 
l'OPEN et mis à jour en cas d'ajouts d'enregistrements n'est 
sauvegardé qu'à la fermeture qui est donc obligatoire (un DOS 
bien conçu devrait prévoir cette sauvegarde à chaque ajout). 


MODIFICATION D'UN ENREGISTREMENT DEJA CREE 


La modification d'une zone dans un enregistrement ne peut 
se faire que par l'intermédiaire de la mémoire tampon. Il 
faut d'abord lire l'enregistrement, puis modifier la zone et 
enfin transférer la mémoire tampon dans le fichier par l'ins- 
truction PUT ##. 


L'oubli de GET #avant LSET affecterait les zones qui ne 
sont pas modifiées. 


fichier 


GET #1,NE mémoire tampon 


2222» 
<s2== YYYYYY | 
PUT #1,NE 


LSET LIB$="YYYYYY" 


860 INPUT "Quel enregistrement ? ";NE 

870 GET #1,NE " Lecture 

880 PRINT "Ancien libelle:";LIB$; 

890 INPUT "Nouveau Libelle? ";X$ 

900 LSET LIB$=X$ " Modification 
910 PUT #1,NE  Réécriture 


PROGRAMME DE SYNTHESE 


NOTION DE MENU 


Plutôt que d'écrire plusieurs programmes indépendants qu'il 
faudrait charger individuellement à chaque fois que l'un d'eux 
doit être exécuté, il est plus pratique qu'ils soient tous 
regroupés dans un seul programme et qu'un système d'aiguillage 
permette de sélectionner un sous-programme particulier. 
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360 
370 


390 
400 


440 


.-Pour revenir au 'menu' ,l'operateur appuie 
sur <ENTER> ou <RETURN> 
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_r €6 
Tr 
PRINT "MODES:" nd CREATION 
PRINT " CR : CREATION" Fe EE 
PRINT " MO: MODIFICATION" al 
PRINT " LIST : LISTE DU FICHIER" _— RETURN | 
ns 


…. 
INPUT "Mode? ";M$ 
DS DR 96 


IF M$="CR" THEN GOSUB 660 :GOTO0 362 


IF M$="LIST" THEN GOSUB Y)):501) 35) TA 


LISTE DU 


FICHIER 


RETURN 


IF M$="MO" THEN GOSUB 1950:GOT9 369 


GOTO 360 


Si l'opérateur répond à la question ‘Mode? par 'CR', c'est 


le sous-programme de création qui est appelé. 


DIFFERENTS MODES 


Dans le programme présenté, sont réunies la création, la 
lecture et la modification d'enregistrements. 


D'autres modes permettent d'éditer le fichier, l'inventaire 
des produits et la répartition des ventes. 


LISTE DU FICHIER 
La liste du fichier s'obtient par : 


740 FOR I=1 TO LOF(1) " Pour BASIC 5. Cf EOF 
750 GET #1,1 

760 PRINT REF$,LIB$ 

770 NEXT I 


REPARTITION DES VENTES 


11 s'agit de classer par ordre d'importance décroissante 
les ventes réalisées sur différents produits. Pour cela, trois 
tables sont constituées par une lecture séquentielle du fichier : 


. 1 table des ventes où est stocké pour chaque article le 
produit PRIXXQOT VENDUE, 

. 1 table des références, 

. 1 table des libellés. 


VNTE() REF $() LIB$() 

! ! ! ! see T4 
1150000 1! IDISQUE! ! DISQUE 5 mega octets ! 
! 40000 ! FECRAN ! ! ECRAN VERT 24 LIGNES 


Ces tables sont ensuite triées et enfin les résultats sont 
édités sous forme d'un tableau puis d'un histogramme. 
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19 ‘ 1X1i/8A5 23.2.81 FICHIER STOCK 

10 

59 CLEAK(1999) ‘ Xeservation pour l'espace chaines de caracteres 
60 OPEN "R",#1,"3[CK" 

70 ! 

80 FIELD #1,12 AS REFS,25 A5 LIBS,4 AS PACIAS,4 AS PVENTES,4 àS QVS,4 AS SIKS 
90 ! 

190 ! DESCRIPTION DES ZONES VU FICHIER "STOCK" 

i10 ? 

120 " &GFS 2 RÉFÉRENCE 12 C 

130 ‘ LIBS :LIBCLLE 25 C 

140 " PACIHAS PRIX ACHAT (SIAPLE PRECISI04) & C 

150 ‘ PVENTES :PRIX VENTE (SIMPLE PRECISION) 4 € 

160 ! V5 2 QUANTITE VENDUE (SIMPLE PRECISIOù) 4 C 

170% STXS :STUCX (SLIPLE PRECISIOX) 4 C 

130 ‘ 

190 

200 ‘ 1 

219 ! 

22042 

239 ‘ 

249 REFS LIBS PACHAS  PVENTES 

259 ‘ 

260 DIH VNTE(50) " TABLF POUR VENTES 

279 DIH REF$S(50) " TABLE POUR REFERENCES 

289 DIHi LIB$S(50) " FABLE POUR LIBELLES 

299 

390 PRINT TAR(19) "MOLDES:":PRINT 

319 PRINT TAB(15) "CR : CREATION 

329 PRINT TAB(15) "L : LECTURE D'UN ARTICLE" 

339 PRINI TAB(15) "MO : MODIFICATION" 

340 PRINT LAB(15) “FIX : FIN (OBLIGATOIRE SI CREATION)" 

350 ‘ 

360 PRINT:INPUT "MODE ";,MS 

370 IF MS$="CR" THEN GOSUB 660:GOTO 300 " Creation 

380 IF M$="L" THEN GOSUB 510:GOTO 300 " Lecture 

390 1F M$="LIST" THEN GOSUZ 990:GOT0 300 ‘ Liste du fichier 
499 IF M$="MO" TUËN GOSUB 1950:GOT0 300 " Modification 

419 IF A$="15" THEN GOSUB 580:GOT0 300 " Incrementation stock 
429 IF M$="INV" THEN GOSUB 1920:GOTO 390 * Inventaire 

430 IF M$="REPV" THEN GOSUB 1340:GO0T0 300 " Repartition des ventes 
44O IF M$="FIN" THEN CLOSE #1:STOP 

450 GOTO 300 

460 * 

470 * 

480 ‘ 

490 ‘=mmmnmnmmm2m2mmm2222n2222222222222222222222222222222222=2222222225 
509 LECTURE D'UN ARTICLE 

510 PRINT:NE=0: INPUT “Quel enregistrement ";NE:IF NE=9 THEN RETURN 
520 GET #1,NE 

530 PRINT:PRINT REFS$S,LI8$ 

540 GOTO 510 

550 '=mmm2m22222222222222222222222222222222222222222222==2=2222=222222= 
570 ! INCREMENTATION STOCK 

575 ‘ 

580 NE=0:INPUT “Quel enregistrement ";NE:IF NE=0 TiEN RETURN 

590 GET #1,NE:PRINT "STOCK="; CVS(STCKS); 

600 INPUT “ Quel increment ";X 

605 INPUT “OK O/N ";RS:IF R$SC>"O" THEN 589 

610 LSET STKS$S=MKSS(CVS(STK$)+X) 

620 PUT #1,NE:G0TO 539 

630 ‘ 
CA 
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646 
650 
660 
670 
680 
690 
700 
710 
720 
730 
740 
750 
760 
770 
780 
790 
800 
810 
320 
830 
840 
850 
360 
870 
880 
890 
900 
910 
920 


930 
940 
959 
960 
979 


980 

999 

1000 
1910 
1920 
1930 
1040 
1050 
1060 
1070 
1980 
1999 
1199 


1119 
1129 


1130 
1140 


1150 
1160 


1170 
1140 
1190 
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: CREATION D'UN ARTICLE 
NE=LOF(1)+1 ‘ Rangement en fin de fichier 
GET #1,NC " Initialisation du buffer 
PRINT 

X$="":INPUT "REFERENCE "5 XS 

IF X$="" TUEN RETURN * Test fin de mode creation 
LSET REFS=XS * Transfert de X$ DANS REF$ 
X$="": INPUT "LIBELLE ":XS 

LSET LIBS=XS 

X=0:INPUT “PRIX D'ACHAT "sx 

LSET PACHAS=MKSS(X) 

X=0: INPUT "PRIX VENTE "5x 

LSET PVENTES=MKSS(X) 

X=0:INPUT "QUANTITE VENDUE "5x 

LSET QVS=MKSS(X) 

X=0:INPUT "STOCK "5x 

LSET STKS$=MKSS(X) 

PUT #1,NE 

PRINT:PRINT "Article range en:";ùE 

GOTO 660 

LU 

L 


fans 2222222-22222222222=22222222=-22222222222222222222222222 


; LISTE OU FICHIER "STOCK" 


LPRINT 
LPRINT:LPRINT "LISTE DU FICHIER" :LPRINI 


LPRINT TAB(5) "REFERENCE" TAB(20) “LIBELLE" TaB(45) 
"PRIX D'ACHAT" TAB(58) "QT VENDUE" 
LPRINT 
FOR I=l TO LOF(1) * Tout le fichier 
GET #1,I 
IF ASC(REFS)=0 THEN GOT) 980 " Enres, vide? 
LPRINI IL TAB(S5) REFS; TAB(20) LIBS; TAB(45) CVS(PACHAS); 
TAB(53) CVS(AVS) 
NEXT I 
RETUR: 
! MODIFICATION D'UN ARTICLE 
! ON. AFFICIIT LES ANCIENNES VALEURS.SI L'OPERATEUR NE 
! VEUT PAS CHANGER CES VALEURS,IL APPUIE SUR "ENTER" 
LU 
PRINT:NE=0: INPUT "QUEL ENREGISTREMENT "35 NE 
IF NE=9) TAEN RETURN " Fin de mode si <ENTER> 
SET #1,NE 
PRINT 
PRINT "REFERENCE : "3; TAS(15); 
PXINT REFS; TAB(45); : XS$S="": INPUT XS:IF XS><"" TAIEN 
LSÈL XEF$=XS 
PRINT "LIRBELLE:" TAB(15) 
PRINT LIBS;:PRINT LA3(45) :XS="":INPUT XS:IF XS$S><"" TAEN 
LSET LIBS=XS 
PRINT "PRIX D'ACHAT:";TAB(i5); 
PRINT CVS(PACHAS);,TAB(45):X=0: INPUT X:IF X><9 THEN 
LSET PACIIAS=AKSS(X) 
PRINT "QUANTL£É VENDUE :"3;TAB(1S) 
PRINT CVS(QY5);TAB(30) :X=0:INPUL X:IF KD<O THEN 
LSET JVS=HKSS(X) 
PUT #L,NE 
GOTO 1950 
lssassséessss 222-22-=2222=2=2==222---2-2-2-2-22=2=22222==2-=22=22=2=222= 
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12950 
1279 
1259 
1299 
1309 
1319 
1329 
1330 
1349 
135) 
1360 
1379 
1320 
1399 
140) 
1419 
1429 
1439 
1499 
1459 
14609 
1479 
1439 
1499 
1509 


15190 
1529 
1530 
1540 
1550 
1560 
1579 
1580 


1590 
1600 
1619 
1620 
1630 
1640 
1650 
1660 
1670 
1680 
1690 
1709 
1719 
1720 
1730 
1740 
1750 
1760 
1770 
1780 
1790 
1800 
1810 
1829 
1339 


LE BASIC ET SES FICHIERS 


' REPARTITION DES VENTES 

: 

* 1/ CONSTITUTION D 3 TABLES: 

' =TABLE DES VENTES VNTE() 
' =TABLE DES REFERENCES REF$() 
: TABLE DES LIBELLES LIBS$() 
' 

N3=0: TTAL=0 : P=0 * NB: NOMBRE DE PIECES 


! " TTAL: TOTAL — TP: TOTAL PARTIEL 
FOR I=l TO LOF(1) | 
#1,L:IF ASC(REFS)=9 GOTO 1440 " Enreg vide? 
PRINT REFS 
NB=ND+L 
VNTE(NH)=CVS(PACHAS)*CVS(QVS) 
REFS(NH)=RErFS 
LIHS(1B)=LIBS 
TÉAL=TTAL#CVS(PACHAS)*CVS(QUS) 
NEXT L 
"  2/ LRI DES TABLES (TRI OU TYPE 'RIPPLE') 
' 
LNV=0 " TEMOIN L'INVERSION 
FOR I=Ll TO HB-i 
IE VNTL(I+L)>V: (I) THEN 
X=VNTE(L): VNTE(L)=VNTE(I+L): VNTE(I+1)=X: 
KS=REFS(L): REF$S(L)=REFS(I+1): REFS(I+L)=XS : 
XS=LIBS(I):LIBS(I)=LIBS(I+1):LIBS(I+L)=XS : INV=1 
NEXT [L 
IF INV><9 GOT) 1480 


GET 


; 3/ EDITIONS RESULTATS 


LPRINT:LPRINT "REPARTILION DES VENTES" :LPRINT 
Tr=0 
LPRINT "REFERENCE" TA3(15) "VENTES" TAB(35) 
"% TOTAL": LPRINT 
FOR I=l TO NB 
TP=TP+VNTE(L) 
LPRINT REF$(1);TAB(15) 
PRINT USING “#H#H#HfFifit 1H 3 VNTE(L); 
LPRINT TAB(35) :LPRINT USING “ ##.1HF"; VNTE(I)/TTAL; 
LPRINT TAB(45S):LPRINT USING “ ##.1#"3;TP/TTAL 


"47 HISTOGRAMME 
AX=) 
FOR I=l TO NB " Recherche du plus grand 
IF VNTE(I)DMX THEN MX=VNTE(I) 
NEXT LIL 
ECU=10/MX * Calcul de l'echelle 
lasnemmmmmsmmrseess Edition 
LPRINT:LPRINT 
FOR I=1 TO NB 
LPRINT REFS(I); 
X=INT(VNTE(I)/MXX19) 
IF K<1 TUEN LPRINT:GOTO 1800 
FOR J=1 TO X:LPRINT “*";:NEXT J:LPRINT ‘ Edition d'une ligne 
NEXT L 
LPRINT TAB(20):LPRINT USING “ECHELLE: ##.##H#{Hf" ; ECH 
RETURN 


lm=mm222222=22222222==2222=-222222222=22222222=222=22222=222= 
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1910 
1920 
1930 
1940 
1950 


1960 
1970 
1980 
1990 
2000 
2010 
2020 


2030 
2040 
2050 
2060 
2065 
2070 
2080 
2090 
2190 
2110 
2120 
2130 


LE BASIC ET SES FICHIERS 


: INVENTAIRE 
TV#=0 " Total en double precision 
LPRINT 


LPRINT :LPRINT "INVENTAIRE" : LPRINT 

LPRINT TAB(3) "REFERENCE" TAB(17) "LIBELLE" TAB(44) 
"PRIX ACiAT" TAB(55) “VALEUR STOCK" 

LPRINT 

LU 


FOR I=l1 TO LOF(1) " Tout le fichier 
GET #1,1I 
IF ASC(REFS)=0 THEN GOTO 2090 " Enreg vide? 
Q=CVS(STKS$) : P=CVS(PACHAS) 
Q#H=VAL(STR$S(Q)): P#=VAL(STR$S(P)) ‘ Conversion en double precision 
cf BASIC ET SES FICHIERS P17 


VA=Q#*P4# 
TV#=TV#+ Vi 
LPRINT L TAB(3) REFS;TAB(17);LIBS; 
LPRINT TAB(45):LPRINT USING “##H#H{H1F. ##" ; CUS(PACHAS); 
LPRINT lAB(5SG):LPRINT USING “##HHIHF. A" 3 Vs 
LPRINT [AB(62):LPRINT USING “#3##Hfifff" ;Q 

NEXT I 

LPRINT 

LPRINT "TOTAL=";TV# 

RETURN 


lmn=mm222==2=22=-222222222222=22222222==22222222=2222222222 
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LISTE DU FICHIER 


REFERENCE LIBELLE RIX D'ACHAT QT VENDUE 
1 ECRAN UCRAN VERT 24 LIGNES 4000 10 
2 DISQUE DISQUE 5 MEGA OCTETS 30000 5 
3 CLAVIER CLAVIER AZERTY 1000 10 
4 IMPRIMANTE IMPRIMANTE 300 LIGNES/MN 5000 4 
5 DISQUETTE DISQUETTIES 8 POUCES 29 1000 


REPARTITION DES VENTES 


REFERENCE VENTES % TOTAL 

DISQUE 150000.00 0.63 0.53 
ECRAN 40000.00 0.17 0.79 
IMPRIMANTE 20000 .00 0.08 0.88 
DISQUETTE 20000.00 0.08 0.96 
CLAVIER 10000 .00 0.04 1.00 
DISQUE ÉCOLE LES LE 

ECRAN x 


IMPRIMANTE  * 
DISQUETTE * 
CLAVIER 
ÉCHELLE: 0.009007 


INVENTAIRE 


REFERENCE LIBELLE PRIX ACHAT VALEUR STOCK 
1 ECRAN ECRAN VERT 24 LIGNES 4000.00 16000.09 
2 DISQUE DISQUE 5 MEGA OCTETS 30000.00 60000 .00 
3 CLAVIER CLAVIER AZERTY 1900.00 5009.00 
4 IMPRIMANTE IMPRIMANTE 300 LIGNES/MN 5000.00 10000 .00 
5 DISQUETTE DISQUETIES 8 POUCES 20.00 4000.00 


TOTAL= 95000 
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SUPPRESSION D'UN FICHIER : KILL “nom de fichier" 


La suppression d'un fichier par programme s'écrit : 
19 KILL "STCK" ‘Le fichier "STCK' doit être clos. 


La place disque occupée par le fichier est récupérée par le 
système pour une allocation ultérieure. 


BLOC DE CONTROLE 
DU FICHIER "STCK/ 


1 GRANULE = 1024 OCTETS 


*x Lors d'une suppression 
de fichier, les diffé- 
rents granules qui lui 
étaient affectés sont ? IT MAP D'OCCUPATION 
récupérés par le système DISQUE (POUR L'ENSEMBLE 
pour d'autres fichiers DES FICHIERS) 


INITIALISATION DE FICHIER 


Sur TRS-80, l'écriture dans un fichier vide au numéro N 
crée, en plus de l'enregistrement N, les N-1 enregistrements 
précédents, avec des valeurs quelconques. Par conséquent, rien 
ne permet de distinguer les enregistrements déjà créés de ceux 
qui ne le sont pas encore. 


Aussi, afin d'éviter cela, les enregistrements d'un fichier 
peuvent-ils être initialisés avec des valeurs ASCII nulles. 


10 INPUT "Nom de fichier? ";NF$ 
20 INPUT "Combien d'enregistrements a initialiser? ":NE 
LU 


4O OPEN "R",#1,NF$ 
50 FIELD #1,255 as X$ 
! 


70 GET #1,LOF(1)+1 " Valeurs ASCII nulles dans buffer 
LU 


90 FOR I=1 TO NE 
100 PUT #1,1 
110 NEXT I 

120 CLOSE #1 


CONSEILS POUR LA MISE AU POINT 


Comment procéder lorsque les informations que l'on pense 
avoir stockées dans un fichier ne sont pas retrouvées ? 


1/ Par insertion d'instructions dans le programme : 


100 LSET LIB$="XXXXXXXXX" 
110 PUT #1,X * Ecriture dans le fichier 


112 GET #1,X " On lit immediatement .Pour test seulement 
114 PRINT LIB$,REF$,X 


120 ..suite du pgm ........... 
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Juste après avoir écrit dans le fichier par PUT#, l'enregis- 
trement est lu par GET#et les zones définies dans FIELD# sont 
visualisées. 
2/ Lecture dans le fichier en "MODE DIRECT’. 

Après l'écriture par PUT#, on interrompt le programme (par 
contrôle C ou break), puis on écrit en mode direct : 


GET #1,X " Mode direct 
PRINT LIB$,REF$ 


DECLARATION DE TABLEAUX PAR FIELD# 


Des tableaux à une ou plusieurs dimensions se déclarent de 
deux façons : 


a/ Les zones ont des longueurs différentes 
FIELD #1,4 AS ZNE$(1),5 AS ZNE$(2),3 AS ZNE$(3),...... 


b/ Si tous les éléments du tableau ont la même longueur : 


100 FOR I=1 to 5 
110 FIELD #1,4#(1-1) AS D$,4 AS ZNES$(I) 
120 NEXT I 


<-D$--> pour I=2 


La variable D$ ne sert qu'à positionner les éléments de la 
table ZNES(). Pour i=2 par exemple, elle positionne ZNES (2) 
en 5. 


- 2 tables à 1 dimension 


100 FOR I=1 to 5 
110 FIELD #1,(4+2)#(1-1) AS D$,4 AS X$(I),2 AS Y$(I) 
120 NEXT I 


— 1 table à 2 dimensions 


100 FOR J=1 TO 5 
110 FOR I=1 TO 3 


120 FIELD #1,(3#2)#(J-1) AS D$,2#(I-1) AS D$,2 AS X$(J,I) 
130  NEXT I 
140 NEXT J 
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CHAMPS MULTIPLES 


Pour un même fichier, plusieurs FIELD (champs) peuvent être 
définis. 


100 FIELD #1,12 AS REF$ ,25 AS LIB$ ,4 AS PACHA$,... 
110 FIELD #1,12 AS ZNE$(1),25 AS ZNE$(2),4 AS ZNE$(3),.. 


La référence par exemple est connue à la fois sous le nom de 
REF$ et de ZNES(1) aussi bien en lecture qu'en écriture : PRINT 
REF$ est équivalent à PRINT ZNES(1). Ceci permet d'accéder à 
une zone soit par un indice, soit par un nom plus mnémonique. 


Cette facilité permet également de définir plusieurs structu- 
res pour un même fichier. Sur l'exemple, l'enregistrement 1 
contient le nombre d'enregistrements du fichier et la date. 

1 Nb enregistrements [rourfrois [an 

2 R5 posent 

3 CX EXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 


REORGANISATION DE FICHIER RANDOM 


Si la récupération des enregistrements inutilisés dans un 
fichier n'est pas prévue par programme, il faut procéder pério- 
diquement à un ‘retassage' du fichier en supprimant les enre- 
gistrements vides. 


Le plus simple, pour indiquer qu'un enregistrement n'est 
plus utilisé, est d'y placer des valeurs ASCII nulles. 


FICHIER SOURCE FICHIER REORGANISE 


DURAND 


UT Æ & D — 


5 INPUT "Nom fichier Source? ";NF$ 


10 OPEN "R",#1,NF$ " Fichier source 

20 OPEN "R",#2,NF$+"X":CLOSE #2 

25 KILL NF$+"X":OPEN "R'",#2,NF$+"X" ‘ Fichier reorganise 
30 " 


4O FIELD #1,128 AS X1$ 
50 FIELD #2,128 AS X2$ 


60 ! 

65 PRINT "Nom du fichier reorganise:";NF$+"Xx" 

70 X2=0 " X2:Pointeur fichier reorganise 
100 FOR X1=1 TO LOF(1) " Lecture de tout le fichier source 


110 GET #1,X1 
120 IF ASC(X1$)=0 THEN 200 
130  LSET X2$=X1$ 


140 X2=X2+1:PUT #2,X2 ‘ Rangement dans le fichier reorganise 
200 NEXT X1 
210. * 


220 CLOSE #1,4#2 
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ENREGISTREMENTS LOGIQUES 


S'il existe des pointeurs vers le fichier réorganisé (dans 
ils doivent bien sûr être mis à jour. 


Sur TRS-80, le choix d'une longueur de 256 caractères pour 


les enregistrements n'est pas très judicieux, une longueur de 
128 aurait mieux convenu. 


Comment définir 2 enregistrements logiques par enregistrement 


physique ? 


DUPONTS{xxxxx No 1 xxHMARTINIxxx No 2 xxx 


DURAND faxxxx No 3 xx] 


L'instruction FIELD permet de définir dynamiquement la 


10 INPUT "Quel enregistrement logique? ";NL 
20 ! 
30 NP=INT((NL-1)/2)+1 * NP:No physique 


position d'une variable dans la mémoire tampon : 


4O PS=((NL-1) MOD 2)+1 ‘ PS:Position dans l'enreg (1,2) 


50 FIELD #1,128#(PS-1) AS D$,12 AS N$ 
60 GET #1,NP 

70 INPUT "Nom? ";X$ 

80 LSET N$=X$ 

90 PUT #1,NP 

100 GOTO 10 


DECLARATION DE TABLEAUX 


Ng devient une table N#() à 2 éléments, 


zones). 


5 FIELD #1,15 AS N$(1),...,15 AS N$(2) 

10 INPUT "Quel enregistrement logique? ";NL 
20 

30 NP=INT((NL-1)/2)+1 

HO PS=((NL-1) MOD 2)+1 

50 GET #1,NP 

70 INPUT "Nom? ";X$ 

80 LSET N$(PS)=X$ 

90 PUT #1,NP 

100 GOTO 10 
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SAISIE POUR FICHIER RANDOM 


Une simple suite d'INPUT et de LSET permet de documenter les 
différentes zones d'un enregistrement. C'est ce que nous avions 
fait dans l'exercice précédent. 


Cette méthode présente deux inconvénients : 


- Dès que le nombre de zones à saisir devient important, 
l'écriture de la suite d'INPUT et de LSET est fastidieuse. 


- En outre, en cours de saisie, on n'a pas la faculté de se 
positionner en arrière sur une zone qui aurait été mal 
documentée. 


En revanche, le programme proposé le permet : nous définis- 
sons les différentes zones à saisir dans la mémoire tampon 
comme des éléments d'une table. 


3 tables contiennent : 


. les noms des zones NZ£ () 

. les longueurs des zones LZ() 

. les types de zones TZ() (1,2,3,4) 

Z$() LZ() TZ() 
NOM: 15 1 
PRENOM: 12 1 ZN$(1) ZN$(2) ZN$(3) 
TELE PH: 20 US rt 
VILLE: 15 1 [Frvox freame 1355-22-56 I 
CPOST: 4 CS ES ESS 


—"! LL Lo Zones definies dans FIELD# 
Noms des longueur type 
zones des zones des zones 


Pour une saisie plus élaborée ‘caractère par caractère', cf. 
programme EDIR. 
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100 
110 
120 
140 
150 
160 
170 
180 
190 
200 
210 
220 
230 
240 
250 
260 
270 
Z(5 
280 
290 
300 
310 
320 
330 
340 
350 
360 
370 
380 
390 
400 
410 
420 
430 
440 
450 
460 
470 
480 
490 
500 
510 
520 
530 
540 
550 
560 
570 
580 
590 
600 
610 
620 
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SAISR 23.5.80 


SAISIE POUR FICHIER RANDOM 


Permet, en cours de saisie,de revenir sur des zones arrieres 
TZ() : 1 Chaines 

2  Entiers -32000<X<32000 
3 Simple precision 

4 X<256 


LU 
LU 
1! 
; LZ() : Longueur des zones 
L NZ$() : Noms des zones 


OPEN "R",1,"SAIS" 

NZ=5 " Nombre de zones 
DATA "NOM:" ,15,1 

DATA "PRENOM:" ,12,1 

DATA "TELEPH:" ,20,1 

DATA M"VILLE:" ,15,1 

DATA "CPOST:"  ,4 ,3 


FOR I=1 TO NZ:READ NZ$(I):READ LZ(I):READ TZ(I):NEXT I ‘ Nom,Longueur ,Type 


' 


FIELD #1,LZ(1) AS ZN$(1),LZ(2) AS ZN$(2),LZ(3) AS ZN$(3),LZ(4) AS ZN$(4),L 


) AS ZN$(5) 
FIELD #1,LZ(1) AS NOM$,LZ(2) AS PRENOM$ 
! 
PRINT:INPUT "NO ENREG? ";NE 
PRINT:GET #1,NE:GOSUB 350:PUT #1,NE 
GOTO 300 
LU 
! SAISIE 
PRINT:PRINT " R : retour zone arriere'":PRINT 
FOR 1=1 TO NZ 
PRINT NZ$(I);TAB(20); 
ON TZ(I) GOSUB 460,470,480 ,490 * Affichage ancienne valeur 
PRINT TAB(45); :X$="": INPUT X$ 
IF X$="R" THEN IF I>1 THEN I=1-1:GOTO 370 ELSE GOTO 370 
IF X$="" GOTO 430 
ON TZ(I) GOSUB 510,520,530,540 
NEXT I 


RETURN 
' 


PRINT ZN$(I);:RETURN " TZ=1 Affichage ancienne valeur 
PRINT CVI(ZN$(I)) ; : RETURN “-TZ3=2 

PRINT CVS(ZN$(I)) ; : RETURN " TZs=3 

PRINT ASC(ZN$(I)) ; :RETURN " TZ=4 

! 

LSET ZN$(I)=X$:RETURN " TZ=1 Nouvelle valeur 


LSET ZN$(I)=MKIS$(VAL(X$)) : RETURN 
LSET ZN$(I)=MKS$(VAL(X$)) : RETURN 


LSET ZN$(I)=CHR$(VAL(X$)) :RETURN 
LU 

‘run 

L 

"NOM: DUPONT 

"PRENOM: JEAN 

"TELEPHONE: 679-99-88 700-99-00 
"VILLE: PARIS 

"CPOST: 75009 
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ALLOCATION D'ENREGISTREMENTS POUR FICHIER RANDOM MICROSOFT D, 


La fonction LOF(x) en Microsoft 5. n'indique plus la fin de 
fichier comme c'était le cas avant l'apparition de CPM. Cette 
fonction peut être remplacée par la gestion d'un compteur dans 
l'enregistrement numéro 1 du fichier. La récupération des 
enregistrements devenus libres peut se faire à l'aide d'une 
bit-map (cf. Basic et ses Fichiers, tome 1, page 85). 


Une autre façon de procéder consiste à chaîner les enregis- 
trements inutilisés entre eux. Chaque nouvel enregistrement 
supprimé est mis en tête de chaîne par exemple. Ce système 
oblige à réserver deux octets systématiquement dans chaque 
enregistrement pour le chaînage. 


Pour se prémunir contre d'éventuels incidents, il faut 
penser à repérer les enregistrements libres par un code (code 
ASCII nul par exemple) de façon à être capable de régénérer 
la chaîne. 


Bien que la gestion d'un chaînage soit relativement simple, 
nous proposons une méthode plus facile à programmer, applicable 
seulement si le nombre d'enregistrements libres peut être estimé. 
On prévoit dans l'enregistrement numéro 1 du fichier, 50 poin- 
teurs vers les enregistrements supprimés. 


# CHAiNAÇE Dés ‘TRous' # POiNTEURS Les 
ENREGISTREA GNTS LIBRES 
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10 ! MICS5 ALLOCATION D'ENREGISTREMENTS POUR FICHIER RANDOM MICROSOFT 5. 

20 

30 ‘ La version 5. Microsoft ne dispose pas de la fonction LOF(x) 

40 ! Un compteur dans l'enregistrement no 1 la remplace. 

50 ! Les adresses des enregistrements supprimes sont stockees dans enreg 1 
10: 


80 OPEN "R",#1,"MIC5" 
90 FIELD #1,15 AS NOM$ 


100 FIELD #1,2 AS CPT$ ! Compteur 

105 FIELD #1,128 AS 11$ 

110 DIM VD$(50) " Pointeurs enreg vides 

120 FOR I=1 TO 50 " Pointeurs enregistrements libres 
130 FIELD #1,2+2#(1-1) AS D$,2 AS VD$(I) 

140 NEXT I 

0 Initialisation enregistrement no 1 avec O ASCII 
160 IF LOF(1)=0 THEN LSET I1$=STRING$(CHR$(0),128):PUT #1,1 

170 

180 GET #1,1:CPT=CVI(CPT$):IF CPT<2 THEN CPT=2 

190 ! 

200 FOR CPT=CPT TO 1000 " MAJ Eventuelle du compteur 


210 GET #1,CPT 

220 IF ASC(NOM$)=0 THEN PRINT "COMPTEUR=";CPT:GOTO 260 
230 NEXT CPT 

240 PRINT "FICHIER PLEIN" :STOP 


260 INPUT "Mode? ";M$ 

270 IF M$="C" THEN GOSUB 310 " Creation 
280 IF M$="S" THEN GOSUB 380 " Suppression 
290 GOTO 260 


300 ‘=======2=======22=2======2=========2===========222= CREATION 


310 GOSUB 460 " Appel recherche enregistrement 
320 X$="":INPUT "Nom? ";X$:IF X$="" THEN RETURN 

330 LSET NOM$=X$:PUT #1,NE 

340 PRINT "Range en:";NE 

350 GOSUB 540 " Appel MAJ compteur ou pointeurs 
360 GOTO 310 


Z2===2=2=2=2222222222=22=2=22=2222222= == SUPPRESSION 
380 INPUT "Quel enregistrement? ; 1 OR NE>=CPT THEN PRINT "Erreur" :RETURN 
400 GET #1,NE 
410 IF ASC(NOM$)=0 THEN PRINT "Deja vide" :RETURN 
420 LSET NOM$=CHR$(0):PUT #1,NE:GOSUB 580 
430 ' Pour O ASCII enreg complet faire:105 FIELD #1,128 AS 11$ 


435 ! 420 LSET I1$=STRING$(128,CHR$(0)):PUT #1,NE 
44O RETURN 
40 Recherche enregistrement libre 


460 GET #1,1 

470 FOR PE=1 TO 50 

480 IF CVI(VD$(PE))=0 THEN 500 

490 NE=CVI(VDS$(PE)):GET #1,NE:IF ASC(NOM$)=0 THEN RETURN ELSE PRINT "Erreur point 
eur":GOTO 500 


500 NEXT PE 

510 PE=0:NE=CPT " Allocation en fin de fichier 

520 RETURN 

530 MAJ compteur ou pointeurs enr libres 


540 GET #1,1 

550 IF PE=0 THEN CPT=CPT+1:LSET CPT$=MKI$(CPT)::PUT #1,1:RETURN 

560 LSET VD$(PE)=MKI$(0):PUT #1,1:RETURN 

70 MAJ pointeurs pour suppression 
580 GET #1,1 

590 FOR PE=1 TO 50 

600 IF CVI(VD$(PE))=0 THEN LSET VD$(PE)=MKIS$(NE) : PUT #1,1:RETURN 

610 NEXT PE 

620 PRINT "Y'a plus de place pour les pointeurs":STOP 

630 
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CHAIS CHAINAGE D'ENREGISTREMENTS INUTILISES POUR FICHIER RANDOM 


La version 5. Microsoft ne dispose pas de la fonction LOF(x) 
Un compteur dans l'enregistrement no 1 la remplace 
Les enregistrements supprimes sont chaines entre eux 


80 OPEN "R'",#1,"chai5" 
90 FIELD #1,15 AS NOM$ 


FIELD #1,2 AS CPT$ ! Compteur 

FIELD #1,128 AS I1$ 

DIM VD$(50) 

FIELD #1,126 AS D$,2 AS TROU$ 

mm Initialisation ne no 1 avec O ASCII 
IF LOF(1)= O THEN LSET I1$=STRING$(CHR$(0),128):PUT #1, 


GET #1,1:CPT=CVI(CPT$):IF CPT<2 THEN CPT=2 


FOR CPT=CPT TO 1000 " MAJ Eventuelle du compteur 
GET #1,CPT 
IF ASC(NOM$)=0 THEN PRINT "COMPTEUR=";CPT:GOTO 220 
NEXT CPT 
PRINT "FICHIER PLEIN" : STOP 
a Menu 
INPUT "Mode? ";M$ 
IF M$="C" THEN GOSUB 290 " Creation 
IF M$="S" THEN GOSUB 390 " Suppression 


GOTO 220 
"z== CREATION 

GOSUB 470 " Appel recherche enregistrement 
INPUT "Nom? ";X$ 

IF X$="" THEN RETURN 

GET #1,NE 

LSET NOM$=X$ 

PUT #1,NE 

PRINT "Range en:";NE 

GOSUB 560 " Appel MAJ compteur ou pointeurs 
GOTO 290 

fs========2==22==22=22==2=22==22====22222==2=2==2227 SUPPRESSION 

INPUT "Quel enregistrement? ";NE:IF NE=1 OR NE=>CPT THEN PRINT "Erreur" :RETURN 
GET #1,NE 

IF ASC(NOM$)=0 THEN PRINT "Deja vide" :RETURN 

PRINT NOM$ 

LSET NOM$=CHR$(0) 

PUT #1,NE 

GOSUB 600 

RETURN 

a Recherche enregistrement libre 

GET #1,1 

IF CVI(TROU$)<>0 THEN NE=CVI(TROU$):GET #1,NE:ATROUS$=TROUS : PE= 1: RETURN 
PE=0 :NE=CPT ‘ Allocation en fin de fichier 

RETURN 

a MAJ compteur ou pointeurs enr libres 
GET #1,1 

IF PE=0 THEN CPT=CPT+1:LSET CPT$=MKI$(CPT):PUT #1,1:RETURN 

GET #1,1:LSET TROU$=ATROUS:PUT #1,1:RETURN 
oo MAJ pointeurs pour suppression 
GET #1,1 

X$=TROU$ 

LSET TROUS$=MKI$(NE):PUT #1,1 

GET #1,NE 

LSET TROUS$=X$ 

PUT #1,NE 

RETURN 


LE BASIC ET SES FICHIERS 


CHAPITRE 2 
ACCES PAR CLE 


Un opérateur n'a pas à connaître les numéros d'enregistrements 
où sont rangés des clients, des produits, des factures, etc... 
Comment donc retrouver un enregistrement contenant une clé 
cherchée ? 


1/ Par recherche séquentielle 
2/ Par table d'index 
3/ Par HASH-CODE 


RECHERCHE SEQUENTIELLE 


La façon la plus simple, (mais aussi la moins rapide), pour 
retrouver une clé dans un fichier consiste à explorer séquen- 
tiellement celui-ci jusqu'à ce que la clé cherchée soit retrouvée. 


10 OPEN "R'",#1,"STCK" 
20 FIELD #1,12 AS REF$,25 AS LIB$,.... 


30 " 

100 INPUT "Cle? ";CLE$ " Entrer seulement les premieres lettres 
105 L=LEN(CLES$) 

110! 

120 FOR I=1 TO LOF(1) " Lire tout le fichier 


130 GET #1,1 
140 IF CLE$=LEFT$(REFS$,L) THEN GOTO 200 


150 NEXT I 

160" 

170 PRINT "La cle cherchee n'existe pas'":goto 100 
180" 

200 PRINT REF$,LIB$ " La cle est trouvee 


210 GOTO 100 


PA) 
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Remarque importante : la zone REF$ étant complétée par des 
espaces à droite au moment de l'écriture dans le fichier, 
(voir LSET), nous comparons CLES à LEFTS(REFS8, LEN(CLES)). 
En outre, ceci permet à l'opérateur, pour la recherche, de 
n'entrer que les premières lettres du nom. 


-REF$ LIB$ 
!R5 LXXXXXXXXXXXXXXXXXXXXXXXX! 
!cx EXXXXXXXXXXXXXXXXXXXXXX XX! 


! EXXXXXXXXXXXXXXXXXXXXXXXX! 


RECHERCHE PAR TABLE D'INDEX 


L'exploration d'une table d'index en mémoire centrale est 
bien sûr plus rapide que l'exploration d'un fichier. 


LECTURE DU FICHIER EN DEBUT DE SESSION 


Une table d'index est créée au début de chaque session de 
travail en lisant tout le fichier (cf. Le Basic et ses Fichiers, 
Tome 1, p. 95). 


INDEX SAUVEGARDE SUR DISQUE 


Afin d'économiser le temps de constitution de la table 
d'index, celle-ci est généralement sauvegardée sur disque 
dans le fichier principal ou un fichier indépendant. 


Compte tenu de la place occupée en mémoire centrale par 
l'index, seules les premières lettres des clés peuvent y 
être gardées. Bien entendu, dans ce cas, plusieurs accès 
disques sont nécessaires pour retrouver une clé si plusieurs 
clés ont les mêmes premières lettres. 


Sur TRS-80, un enregistrement de 256 caractères peut contenir 
256/(5+2)=36 clés, si les clés ont une longueur de 5 caractères 
et que 2 caractères sont nécessaires pour les pointeurs vers 
le fichier principal. 


svej0 P#0 


D 
FiCHier rN)ex 


LGCL=S  Clonçuéur CLE) 
eNCL=INT(254/(5+2))  NBc>|c 
CNOMBRE Dé CLES PAR 

cNRegisrRemer Du Fichier Ier) TraBte TABLE 
cLeg0) inex() 


Fichier 
PRinCI PAL 


La recherche d'une clé se programme ainsi : 


NBC : Nombre de clés dans la table d'index 
LGCL : Longueur des clés dans la table d'index (LGCL=5) 
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500 INPUT "Cle cherchee? ";X$ " Entrer seulement les premieres lettres 
505 L=LEN(X$) 

510 ! 

520 FOR I=1 TO NBC " Lecture de la table CLE$() 


530 IF LEFT$(CLE$(I),L)<>X$ AND LEFT$(X$,LGCL)<>CLE$(I) THEN GOTO 570 

540 GET #1,INDEX(I) 

550 ' 

560 IF X$=LEFT$(REF$,L) THEN PRINT REF$;LIB$:GOTO 500 ‘ Cle trouvee 

570 NEXT I 

580 ! 

590 INPUT "Nouvelle cle OK (O/N)? ";R$:IF R$<>"O" THEN GOTO 500 

595 RANG=LOF(1)+1 " Rgmt nouveau produit en fin de fichier 
600 LSET REF$=X$ 

605 ' Saisie article 

610 ! 

620 PUT #1,RANG 

630 NBC=NBC+1:CLES$(NBC)=X$:INDEX(NBC)=RANG " Ajout cle en fin de table d'index 
640 GOSUB 1000 " Sauvegarde de la table d'index 
650 GOTO 500 


Sauvegarde de la table d'index : 

En cas d'incident (coupure de tension par exemple), la table 
d'index en mémoire centrale est perdue. Aussi convient-il de 
la sauvegarder sur disque à chaque ajout de clé, du moins la 
partie modifiée. 


L'ajout de clé se faisant en fin de table, le numéro de la 
case modifiée est NBC. 


NCL : nombre de clés par enregistrement du fichier 
index (256/(5+2)=36) 

SCLES () : définie dans FIELD# du fichier index pour 
sauvegarde de CLES8() (contient NCL éléments) 

PTS () : définie dans FIELD#du fichier index pour 
sauvegarde de INDEX() 

NBC : nombre de clés dans la table index 


10 OPEN "R",#1,"STCK" 
20 FIELD #1,12 AS REF$,25 AS LIB$,... 
30 OPEN "R'",#2,"INDEX" " Fichier index 
35 LGCL=5 : NCL=36 * Longueur des cles 
4O FOR I=1 TO NCL 
50 FIELD #2,(LGCL+2)#(1-1) AS D$,(LGCL) AS SCLES$(I),2 AS PT$(I) 
60 NEXT I 
' 


70 
1000 DB=INT((NBC-1)/NCL) * DB:No de bloc a sauvegarder 
1010 K=DB#NCL+1 ‘ K :Debut de la table a sauvegarder 


1015 GET #2,DB+1 

1020 FOR J=1 TO NCL 

1030 IF CLE$(K)="" THEN PUT #2,DB+1:RETURN 

1040 LSET SCLE$(J)=CLE$(K):LSET PT$(J)=MKI$(K) :K=K+1 
1050 NEXT J 

1060 PUT #2,DB+1 

1070 RETURN 


Remarque : l'instruction 1015 est nécessaire. En effet, sans 
celle-ci, la mémoire tampon contiendrait les valeurs d'un 
ancien bloc. 
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La totalité de l'index peut également être sauvegardée 
seulement en fin de session. Mais si celle-ci est interrompue, 
l'index ne sera pas à jour pour les sessions ultérieures. 


Transfert de la sauvegarde sur disque en mémoire centrale : 


En début de session, les tables CLES() et INDEX() sauvegardées 
sur disque doivent être amenées en mémoire centrale : 


100 NBC=0 

110 FOR I=1 TO 10 " 10 enregistrements pour le fichier index 
120 GET #2,1I 

130 FOR J=1 TO NCL 


140 IF ASC(SCLE$(J))=0 THEN 170 

150 NBC=NBC+1:CLES$(NBC)=SCLES$(J) : INDEX(NBC)=CVI(PT$(J)) 
160 NEXT J 

170 NEXT I 


Régénération d'un index 


Il doit toujours être prévu un mode capable de regénérer 
l'index en cas de destruction de celui-ci ou d'incohérence 
avec le fichier principal. Pour cela, il suffit de régénérer 
la table d'index par une lecture séquentielle du fichier, puis 
de la sauvegarder. 


200 IF M$="CRI" THEN GOSUB 2000 :STOP " Mode creation index 
2000 CLOSE #2:KILL "INDEX":OPEN "R",#2," INDEX" " RAZ du fichier index 


2010 FOR I=1 TO 500:CLE$(I)="":INDEX(I)=0:NEXT I ‘ RAZ de CLE$() et INDEX() 
2015 NBC=0 


2020 FOR I=1 TO LOF(1) " Lecture du fichier principal 

2030 GET #1,1 

2040 IF ASC(REF$)=0 THEN 2060 " Enregistrement vide? 
2050  NBC=NBC+1:CLES$(NBC)=REF$:INDEX(NBC)=I " Ajout de la cle 

2060 NEXT I 

2070 1 Sauvegarde de la table CLE$() dans le fichier index. 
2100 W=1 

2110 FOR I=1 TO 10 " 10 enreg maxi pour l'index 

2120 GET #2,1I 

2130 FOR J=1 TO NCL " NCL:nb de cles par enreg du fichier index 
2140 IF CLE$(W)="" THEN PUT #2,I:RETURN 

2150 LSET SCLE$(J)=CLES$(W) :LSET PT$(J)=MKI$(INDEX(I)) :W=W+1 


2160  NEXT J 
2170  PUT #2,1I 
2180 NEXT I 
2190 RETURN 


INDEX AVEC "TROUS" 


Pour des fichiers 'stables', c'est-à-dire, avec peu d'ajouts 
de clés, des trous dispersés dans un index trié évitent des 
décalages nombreux en cas d'insertion de clé. 


Toutefois, si les ajouts de clés viennent à l'emporter sur 
les suppressions, une réorganisation de l'index est nécessaire. 
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TABLE 


cueg() 


# FICHIER INDEX TRIE AVEC TROUS 
POUR DECALAGES FICHIER PRINCIPAL 


Exemple : un dictionnaire pourrait être construit sur ce 
principe : 


table FICHIER DICTIONNAIRE(TRIE) 


ABAQUEÏ --> FJABAQUE Îxxxxxx| ABATTOIRIxxxxxxx place libre pour 
BAGAGEÏ --> }BAGAGE f[xxxxxx | BARRE XXXXXXX insertions 
>) 


HASH-CODE 


Bien que peu connu, le principe de cette méthode d'accès 
est simple. L'adresse de rangement d'une clé est définie par 
un calcul effectué sur celle-ci (la somme des positions dans 
l'alphabet des premières lettres par exemple). 


FICHIER 


{ | 34 [marin [xxxx | 
43+ LL ut 
# L'ADRESSE DE RANÇGEMENT 
sr caicuiéé AVEC LA (LE. 


Le même calcul étant effectué à la lecture, nous retrouvons 
une clé cherchée en un seul accès disque. 


Bien entendu, plusieurs clés fournissent la même adresse de 
rangement. Dans ce cas, les 'collisions' peuvent être résolues 


en rangeant la nouvelle clé à côté de l'adresse calculée ou par 


des chaînages vers une zone des collisions. 


# CottisionS: PLUSIEURS CLES 
ONT LA Même ADRESSE Dé RANGEMENT 


Plus le taux d'occupation du fichier est grand, plus les 
collisions augmentent (et le temps d'accès aussi bien sûr). 
On doit donc consentir une perte de place de l'ordre de 30 à 
40 %. 
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L'algorithme de rangement proposé n'est évidemment qu'un 
exemple. En réalité, un bon algorithme doit répartir les clés 
le plus uniformément possible dans le fichier. 


Appliquée sur des fichiers virtuels (c'est-à-dire, où la 
place disque n'est allouée que pour les enregistrements où il 
y a écriture), cette méthode est très pratique. Hélas, les DOS 
actuels ne font l'allocation que par blocs de 1K minimum. 


HASH-CODE SUR UNE TABLE 


Si la mémoire centrale disponible est suffisante, le système 
de Hash-Code peut être appliqué sur une table (sur l'exemple, 
les nouvelles clés sont rangées en fin de fichier). 


La table d'index doit bien entendu être sauvegardée sur 
disque. 


anjex D 


FICHIER 


dre spg 
6834 [4000 Dé 
8 


RESTE: 834 -_ ” 


M LE HASH-co)e Esr APPLi QUE 
AOOO ELEMENTS SUR La TABLE INDEX () 


HASH-INDEX 


La table en mémoire centrale ci-dessus peut être supprimée. 
L'accès par Hash-Code se fait alors sur un index de pointeurs 
résident sur disque. Deux accès disques sont nécessaires pour 
accéder à l'enregistrement cherché. 


On entre par Hash-Code dans l'index de pointeurs. 


burn fm 
PRRTIN — Ponaoenenonnex 


Une variante de la méthode précédente consiste à définir des 
"blocs' d'index dans lesquels on 'entre' par Hash-Code. Puis, 
à l'intérieur d'un bloc, la recherche se fait séquentiellement. 


Un bloc de débordement est prévu pour les clés qui n'auraient 
pas trouvé de place dans le bloc à l'adresse calculée. 


INDEX=CLE MOD 20 " 20 blocs dans l'index 


34 


LE BASIC ET SES FICHIERS 


A l'intérieur de l'index, nous rangeons soit la clé alphabé- 
tique, soit la clé numérique (calculée par Hash-Code), plus 
économique en place. 


FICHIER Index 


# ON ENTRE FAR HASH-CO)E JANS 
UN Blot DE Li’ Index 


HASH-CODE ET ALLOCATION DYNAMIQUE 


Nous proposons une variante de Hash-Code économique en place 
mémoire et assurant l'allocation dynamique des enregistrements. 


Ajout d'une clé : 


Nous faisons correspondre à une clé alphabétique, par un 
algorithme quelconque, une clé numérique que nous rangeons 
dans la première case libre d'une table HASH%() puis nous 
rangeons la nouvelle clé dans l'enregistrement correspondant. 


Recherche d'une clé : 


On calcule, comme pour la création, une clé numérique dont 
on recherche la position dans la table HASH%. Il suffit ensuite 
de lire l'enregistrement correspondant. Si la même clé numérique 
existe en plusieurs exemplaires, les enregistrements correspon- 
dants doivent être lus jusqu'à ce que la clé cherchée soit 
trouvée. 


Suppression d'une clé 


En cas de suppression d'enregistrement, la case associée de 
HASH#() se trouve libérée pour un ajout ultérieur. Ainsi, 
l'allocation dynamique des enregistrements est assurée impli- 
citement. 


Nous avons choisi de repérer les enregistrements inutilisés 
par -32000, 0 repérant la fin de table. En choisissant 0 pour 
identifier les enregistrements libres, il nous faudrait explorer 
systématiquement toute la table lors d'une recherche de clé. 


La table HASH3%() occupe NX2 octets, ce qui est moins encombrant 
qu'une table d'index classique. La recherche séquentielle, péna- 
lisante en interprèté, devrait être transparente en compilé. 


Si on choisit de trier la table HASH%() afin d'y faire une 
recherche dichotomique, il devient nécessaire de lui associer 
une table d'index (cf. accès indexé et allocation dynamique). 
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FICHIER PRINCIPAL 


ARE, es 
7e Lsa2s : 


10 
30 

40 

60 

70 

80 

90 

460 
470 
490 
500 
510 
515 
530 
540 
550 
560 
570 
580 
590 
600 
610 
620 
630 
640 
650 


= 8834 3 


MARTINET 27 cues 
4-32000 
# HASH-Co)e €T ALLOCATION Dynamique 


" HASH 18.11.80 

: HASH-CODE et ALLOCATION DYNAMIQUE 

' 

‘ Les enregistrements 1 a 3 servent a la sauvegarde de HASH#() 
nées cie sets en déesse 

OPEN "R'",#1,"HAS" 

ee CHR$(31) 


660 


670 
680 
690 
700 
710 
720 
730 
740 
750 
760 
770 
780 
790 
800 
810 
820 
830 


EE " À ADAPTER (125 SUR TRS80) :nbre de cles par enregistrement 
DIM HASH3(NCLES#3) " Table des cles numeriques 
DIM SHASH$(NCLES) " Definie dans FIELD# pour sauvegarde de HASHZ 
FIELD #1,12 AS N$ 
FIELD #1,(2#NCLES) AS 11$ * Buffer complet de #1 
FOR I=1 TO NCLES:FIELD #1,2#(1-1) AS D$,2 AS SHASH$(I):NEXT I 
GOSUB 1120 " Appel lecture HASH4 
LU 
INPUT "Mode ? C,A ";M$ 
IF M$="C" THEN GOSUB 610 " Appel CREATION 
IF M$="A" THEN GOSUB 1220 " Appel SUPPRESSION 
Ro 560 
f======2============2===============2======2=2== CREATION/RECHERCHE D'UNE CLE 
PRINT:INPUT "NOM? ";NOM$ 
IF LEN(NOM$)<3 THEN RETURN 
GOSUB 750 ‘ Appel recherche cle 
ON R GOTO 650,670 
PRINT N$,RANG:GOTO 610 " La cle existe 
INPUT "NOUVEAU NOM OK? ";R$:IF R$<>"O" THEN GOTO 610 ‘ La cle n'existe pas 
PRINT EF$ 
"LSET I1$=STRINGS$(CHR$(O) , NCLES#2) " Initialisation buffer avec O ASCII 
HE N$=NOM$:PUT #1,RANG:HASH#(RANG)=CLE:GOSUB 930:GOTO 610 
oo Recherche d'une cle 

L 
Ÿ Entree:NOM$ Retour : RANG: Adresse de rangement dans le fichier 
: R=1 : La cle existe /R=2 : N'existe pas 
FOR I=1 TO 3:X(I1)=ASC(MID$(NOM$,I,1))-64:NEXT I 
CLE=X(1)#26#26+X(2)#26+X(3) * Calcul d'une cle numerique 
PLIB=0 " Position libre dans le fichier 
FOR 1#%=3+1 TO 3#NCLES " Lecture de la table HASHY# 

IF HASH#(1#%)=0 THEN 880 " Fin de table? 

IF HASH?(I#) CCLE THEN 840 

GET #1,1% 

IF NOM$=LEFT$(N$, LEN(NOM$)) THEN RANG=1%:R=1:RETURN " Nom trouve 
' 
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re IF PLIB=0 THEN IF HASH#(1%)=-32000 THEN PLIB=14 " -32000:case libre 

50 NEXT I4 

860 PRINT "C'est plein" :STOP 

870 ! 

880 IF PLIB=0 THEN PLIB=1% 

890 R=2:RANG=PLIB:RETURN 

“et | A Sauvegarde de la table HASH3() 

920 ! DB : No du bloc de HASH#() a sauvegarder.(0,1,2,..) 

930 DB=INT((RANG-1)/NCLES) 

940 NB=DB*NCLES 

950 GET #1,DB+1 

960 FOR J=1 TO NCLES 

970 NB=NB+1:LSET SHASH$(J)=MKI$ (HASHZ (NB) ) 

980 NEXT J 

990 PUT #1,DB+1 

1000 RETURN 

DO 

1050 ‘ 

1060 ! 

1070 ‘ 

1080 

1090 ‘ L'ecriture directe dans le quatrieme enreg cree les 3 premiers avec 

1095 ‘ des valeurs quelconques . 

1100 ‘ 

1110 ! LECTURE DE LA TABLE HASH#() 

1120 NB=0 

1125 IF LOF(1)=0 THEN LSET I1$=STRING$(CHR$(O) ,NCLES#2):FOR 1=1 TO 3: PUT #1,1: 
NEXT I:LSET SHASH$(1)=MKI$(32000):PUT #1,1 ‘ Initialisation index avec O ASCII 

1130 FOR I=1 TO 3 

1140 GET #1,1 

1150 FOR J=1 TO NCLES 

1160 NB=NB+1:HASH#(NB)=CVI(SHASH$(J)) 

1170 NEXT J 

1180 NEXT I 

1190 RETURN 

1200 ‘============================================ SUPPRESION 

1220 INPUT "Nom? ";NOM$ 

1230 IF LEN(NOM$)<3 THEN RETURN 

1240 GOSUB 750:0N R GOTO 1260,1250 " Appel recherche cle 

1250 PRINT:PRINT "N'existe pas":GOTO 1220 

1260 LSET 11$=STRING$(CHR$(O) ,NCLES#2):PUT #1,RANG " Suppression de l'enregist 

rement 

1270 HASH#(RANG)=-32000 " -32000 pour reperer une case vide 

1280 GOSUB 930 

1290 GOTO 1220 

1902 anne none ses er Sense — 

1293 ASSOCIER CE PROGRAMME AVEC 'SAIZ' pour obtenir un programme de saisie 

1294 ! avec acces par cle. 

1295 ! 1/ *MERGER' les 2 programmes sauvegardes en ASCII par 'SAVE "XX!" ,A"! 

1296 ! 2/ ajouter 690 LSET I11$=...:GOSUB 1320 

1297 3/ ajouter 650 PRINT EF$:GOSUB 1320:PUT #1,RANG:GOTO 610 

1298 ‘ 4/ Supprimer 86 et 445 
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Régénération de la table HASH%() 

Un mode de régénération de la table HASH%() (en cas de 
destruction) peut se programmer ainsi : 
2000 LSET I1$=STRING$(CHR$(O),NCLES#2):FOR I=1 TO 3:PUT #1,I:NEXT I 


2010 FOR I=1 TO NCLES*#3:HASHZ(I)=0:NEXT I ‘ RAZ de la table HASH#() 
2020 ‘ 

2030 FOR NE=1 TO LOF(1) " Lecture du fichier(cf EOF pour 5.) 
2040 GET #1,NE 

2050 IF ASC(N$)=0 THEN CLE=-32000 :GOTO 2100 " Enreg vide? 

2060 FOR I=1 TO 3:X(I)=ASC(MID$(N$,I,1))-64:NEXT I ‘ Calcul de clé 
2070 CLE=X(1)#26#26+X(2)#26+X(3) 

2090 

2100 HASH#(NE)=CLE : RANG=NE 

2110 GOSUB 930 ‘ Appel sauvegarde de HASHZ() 


2120 NEXT NE 


Remarques sur le programme : 


Un sous-programme de recherche d'une clé fournit en retour 
un indicateur R=1 si la clé existe ou R=2 si la clé n'existe 
pas. À chaque ajout, le morceau de HASH3%() modifié est sauve- 
gardé sur disque. 


Remarques sur le Hash-Code classique : alors que l'accès indexé, 
lorsque l'index est trié, permet d'obtenir une liste des clés 
dans l'ordre instantanément, le Hash-Code ne le permet pas. 


Si une adresse de rangement, dans le but d'obtenir une meilleure 
répartition à l'intérieur du fichier, a été calculée sur toutes 
les lettres d'un nom, il n'est pas possible de retrouver un nom 
avec seulement les premières lettres. 


En revanche, le système proposé permet, compte tenu des poids 
affectés aux premières lettres, de retrouver un ensemble de 
clés dans un certain voisinage. 


Exemple : les noms commençant par 'MA' seront retrouvés par : 


100 INPUT "Nom? ";X$ 

110 ! 

120 calcul de cle 

130 

200 FOR I=1 TO 100 

210 IF CLE<HASH#(1)-100 OR CLE>HASH(I)+100 THEN GOTO 300 
220 GET #1,1 

230 PRINT N$ 

300 NEXT I 


RUN 
Cle? MA 


MARTIN 
MARTY 
MARTINET 


Recherche rapide dans la table HASH : 


La recherche séquentielle dans la table "HASH' pourrait être 
accélérée en compactants ses éléments par MKIS, (elle deviendrait 
alors une table de chaînes), et en y effectuant la recherche de 
clé à l'aide de INSTR. 
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10 RECHERCHE et AJOUT dans une TABLE avec 'INSTR' 

20 

30 

10 Une recherche sequentielle dans une table en BASIC interprete est longue. 


! 
LI 
! 
! 
50 Le compactage de ses elements sous forme d'une table de chaines 
' 
! 
U 
U 


60 permet d'effectuer plus rapidement la recherche a l'aide de la 
70 fonction 'INSTR' 

80 

90 La table HASH$() de dimension 3 est sauvegardee dans un fichier RANDOM. 
100 ! 

110 

120 NCLES=10 " Nombre de cles par chaine (122 maxi) 
130 LCHAI=NCLES#2 

140 OPEN "R'",#1,"HAS" " Sauvegarde de la table HASH$() 

150 FIELD #1,(LCHAI) AS I1$ 

154 ‘-____- Initialisation des 3 premiers enreg avec O ASCII 


155 IF LOF(1)=0 THEN LSET I1$=STRING$(CHR$(O) ,NCLES#2):FOR I=1 TO 3:PUT #1,I:NEXT I 


160 "ms Lecture de la table HASH$() sauvegardee 
170 FOR I=1 TO 3 
180 GET #1,1 
190 HASH$(I)=11$ 
200 NEXT I 
210 tmmnsemmme Recherche 
220 ‘ 
230 INPUT "Quel nombre cherchez vous? ";X 
240 X$=MKIS$(X) 
L 


250 

260 FOR LI=1 TO 3 " 3 chaines de NCLES 
270 DR=1 * Debut de recherche 
280 ‘ 


290 P=INSTR(DR,HASH$(LI),X$):IF P=0 THEN 340 

300 IF (P MOD 2)=0 THEN DR=P+1:GOTO 290 

310 PRINT "Position de X:";P;LI;CVI(MID$(HASH$(LI),P,2)) 
320 GOTO 230 

330 ! —— Recherche fin de table 

340 DR=1 

350 PZ=INSTR(DR,HASH$(LI) ,MKI$(0)):IF PZ=0 THEN 380 

360 IF (PZ MOD 2)-=0 THEN DR=DR+1:GOTO 350 

370 GOTO 410 

380 NEXT LI 

390 STOP 

4OO 1 Ajout en fin de table 

410 X$=HASH$(LI) :HASH$(LI)=LEFT$(X$,PZ-1)+MKI$(X)+RIGHT$(X$, LCHAI-PZ-1) 
420 LSET I1$-=HASH$(LI):PUT #1,LI 

430 PRINT "Element insere" 

44O PRINT "Position:";PZ 

450 GOTO 230 


39 


LE BASIC ET SES FICHIERS 


CHAPITRE 3 
LES TRIS 


Tout a été dit. De nombreux livres y sont consacrés. Et 


pourtant, devant toutes ces méthodes de tri, beaucoup hésitent. 
Quelle méthode choisir ? 


Nous ne reprendrons pas tous les aspects théoriques sur les 
tris. Nous en ferons simplement un rapide panorama. 


En fonction de quoi choisir son tri ? 


- du nombre d'éléments à trier, 
- éventuellement de l'état de la liste à trier (liste 
presqu'en ordre). 


Intéressons-nous d'abord aux deux tris les plus simples, les 
plus connus, mais aussi les moins rapides : Bubble et Ripple. 


RIPPLE 


Les éléments adjacents de la table à trier sont successivement 
comparés et inversés s'ils ne sont pas dans l'ordre. Les 
comparaisons se font en progressant de 1. Lorsque toute la 


table a été explorée, le plus grand élément doit être en fin 
de table. 


Une seconde exploration de la table permet d'amener le plus 


grand des N-1 éléments restants en avant dernière position de 
la table. 


Après N passages au maximum, la table sera en ordre. 


En réalité, on positionne généralement un témoin d'inversion 
à 1 pour se souvenir en fin de table s'il y a eu ou non inversion, 
car si ce n'est pas le cas, on peut en conclure que la table 
est en ordre et stopper le tri avant N passages. 


95 K=N " Tri RIPPLE 
97" 
100 INV=0 


110 FOR I=1 TO K-1 


120 IF A(I+1)<A(I) THEN SWAP A(I+1),ACI):INV=1 
130 NEXT I 
140 IF INV<>O THEN K=K-1:GOTO 100 ‘ On diminue de 1 le nombre d'elements a explorer 


" A chaque passage. 
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# COMPARAISON DE 
2 ELEMENTS ADJACENTS 


Si le tri doit s'effectuer sur une table déjà en ordre avec 
quelques éléments ajoutés en fin de table, le tri devra être 


fait en sens inverse. Ainsi X passages seulement seront néces- 
saires pour insérer les X éléments ajoutés. 

95 K=1 

97-" 

100 INV=0 

110 FOR I=N-1 TO K STEP-1 


120 IF A(I+1)<A(I) THEN SWAP A(I+1),A(I):INV=1 
130 NEXT I 


140 IF INV<>O THEN K=K+1:GOTO 100 ; 
DesÀ 
CN ORDRE 


X ELEMENTS 
; 
AJOUTES 


4 rt 
x AJOU UNE TABLE TRIEG 


BUBBLE 


On compare d'abord le premier élément aux N-1 autres en 
inversant, chaque fois que l'un d'eux est plus petit, de façon 
à amener le plus petit en première position. 


En procédant ainsi sur les N-1 éléments restants, on amène 
le plus petit de ceux-ci en seconde position dans la table, etc. 


TABLE AU) 
10 FOR I=1 TO N-1 I 
20 FOR J=I+1 TO N 
30 IF A(J)<A(I) THEN SWAP ACI),A(J) 
40 NEXT J 3 
50 NEXT J 


& COMPARAÏiSON DU | Asus 
AVEC LES AUTRES 
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Contrairement à la méthode précédente, le tri ne peut être 
stoppé par le test d'un témoin d'inversion. 


SHELL 


Avec les méthodes de tri du type Ripple ou Bubble, un grand 
nombre placé en début de table ne remonte que progressivement 
en fin de table. Avec Shell, la comparaison s'effectue entre 
deux éléments séparés par un écart égal, au départ, à la moitié 
de la taille de la table. 


boat d 


4) ECART=N/2 2) CARTE N/4 3) ECART=4 
JusQUu'A CE QU'iL N'y 
AÏT PLUS D'INVERSIONS 


100 ECART=N " SHELL 

105 ? 

110 ECART=INT(ECART/2):IF ECART<1 THEN STOP 
AIS? 

120 INV=0 


130 FOR I=1 TO N-ECART 

140 J=I+ECART:IF A(I)>A(J) THEN SWAP A(I),A(J):INV=1 
150 NEXT I 

160 IF INV=1 THEN 120 ELSE 110 


SHELL/METZNER 


Cette méthode est sans doute celle qui présente le meilleur 
rapport 'performance/complexité' : 


100 ECART=N " SHELL-METZNER 
105 ‘ 

110 ECART=INT(ECART/2):IF ECART<1 THEN STOP 
120 J=1:K=N-ECART 

125: ! 

130 I=J 

140" 

160 M=I+ECART 

170 IF A(I)<=A(M) THEN 210 

180 SWAP A(M) ,A(I) 

190 I=I-ECART:IF I<1 THEN 210 ELSE 160 
200 ! 

210 J=J+1:1IF J>K THEN 110 ELSE 130 
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TRIS 28.11.80 


On compare le Jeme element (au depart J=2) a tous ceux d'une liste deja 
en ordre(au depart le premier element) et on l'insere a sa bonne position 


J ---2> ! 


INPUT "Nombre? ";N 
DIM A(N) 
LU 


FOR I=1 TO N 
A(I)=INT (RND(1)*1000) 
TI 


FOR J=2 TO N 
X=A(J) 
FOR I1=J-1 T0 1 STEP-1 
IF X>A(I) THEN 390 
A(I+1)=A(I) 


Cette methode 


Remplacer 


, 
! 
' 
' 
! 
' 
' 
! 
! 
' 
' 
! 
! 
! 
' 
' 
! 
' 


la table. 


FOR J=2 TO N 


TRI 


TR 


pa 


PAR INSERTION 


I PAR INSERTION 


Sauvegarde de A(J) 


Comparaison du Jeme a tous les autres 


Les decalages sont finis 
On decale pour inserer 


Insertion 


est bien adaptee au tri d'une table a laquelle 
on a ajoute des elements en fin de table. 


r FOR J=N TO N+A 


partie deja en ordre 


ajouts 


Le mieux est encore d'inserer chaque nouvel element des qu'il est ajoute a 
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10 
20 

30 

10 

50 

60 

70 

80 

90 

160 
170 
180 
190 
200 
210 
220 
230 
240 
250 
260 
270 
280 
290 
300 
310 
320 
330 
340 
350 
360 
370 
380 
390 
400 
410 
420 
430 
440 
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TRIPI LE 11/7/80 


TRI PAR PERMUTATION D'INDICES 


On recherche la position du plus petit de N elements pour l'amener au 
premier rang de la table. 

On procede de la meme facon sur les N-1 elements restants pour amener 
le plus petit de ceux ci en seconde position. 


: REMPLISSAGE D'UNE TABLE A() 

ÿ AVEC DES NOMBRES ALEATOIRES 
DEFINT I-Z 

INPUT "TAILLE ? ";TAILLE 

DIM A(TAILLE) 


FOR I=1 TO TAILLE:A(I)=RND(1):PRINT A(I):NEXT I 
Re Sd CT M NN NS 
LU 
! TRI 
FOR I=1 TO TAILLE-1 
PPETIT=I " Position du plus petit 
FOR J=I+1 TO TAILLE " Recherche du plus petit de I a TAILLE 
IF A(J)<A(PPETIT) THEN PPETIT=J 
NEXT J 
SWAP A(PPETIT),A(I) ‘ Rangement du plus petit en I 
NEXT I 
en nt D ts es ie ter ir ci RSS cit si etienne nes 
: EDITION 
PRINT 


FOR I=1 TO TAILLE:PRINT I,A(I):NEXT I 
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METHODE DE TRI RAPIDE (QUICKSORT) 
L'idée est la suivante : 


On répartit la suite de nombres à trier de telle sorte que tous 
les éléments inférieurs à un élément médian (qui reste à déter- 
miner) soient à gauche de celui-ci et que tous ceux qui lui 
sont supérieurs soient à sa droite. 


[70 61 16 48 29 18 59 20 74 à 3 70 0 3 22 39 59 30 58 10] AVANT 


element median de reference 
Ÿ 
[3 30 16 22 29 18 3 20 O 10][36][70 74 59 48 39 59 61 58 70] APRES 


elements<=36 elements > 36 


En procédant ainsi successivement sur les sous-ensembles générés, 
on obtient une suite d'ensembles ordonnés. 


On observe qu'au moment où la taille des sous-ensembles 
devient inférieure à 10, il est plus rapide d'achever le tri 
par une méthode classique (Ripple ou Insertion) que de pour- 
suivre la partition. 


E1<E2 E2<E3 E3<E4 EU4<E5 E5<E6 


Choix de l'élément médian de référence 


On choisit un élément médian parmi trois éléments : ceux de 
gauche, du milieu et de droite, de façon à répartir avec un 
élément ni trop petit, ni trop grand. 


A l'issu de ce choix, l'élément médian de référence est 
rangé en première position de l'ensemble traité. 
Pile des adresses des partitions à traiter : 


Nous ne pouvons partitionner qu'un ensemble à la fois; les 
adresses des partitions qui restent à traiter sont stockées 
dans une pile. 


Celle-ci doit avoir une taille d'autant plus grande que le 
nombre d'éléments à trier est important et que la limite 
inférieure de partition est faible. 


q + + 
PPILE 4 41 


a 
QT BIT HT | 


473 A1 


à Pile Des ADRESSES DES PARTITIONS A TRAÎTER 
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Exemple avec LINF=4 


i=1 j=21 


iz12 j=21 


i=12 j=19 


is1 ÿ=11 


iz5 j=11 


70 61 16 48 29 18 59 20 74 [36|3 70 0 3 22 39 59 30 58 10 DEPART 


(Ter 16 48 29 18 59 20 74 10 3 70 0 3 22 39 59 30 58 70 | SUITE TRAITEE 


G 30 16 22 29 18 3 20 o 16]é]ffo 74 59 u8 39 59 61 58 70] RESULTAT 


3 30 16 22 29 18 3 20 O 10 pe 74 59 48 39 59 61 58 70} SUITE TRAITEE 


3 30 16 22 29 18 3 20 0 10 36 (58 70 59 u8 39 59 6f[frQ[7A] RESULTAT 


3 30 16 22 29 18 3 20 O 10 36 58170 59 48 39 59 61,70 74 SUITE TRAITÉE 


3 30 16 22 29 18 3 20 0[10]36 fis 3] Gdf59 10 59 61] To 74 RESULTAT 


10[30 16 22 3 18 3 20 0 29| 36 48 39 58 59 70 59 61 70 74 SUITE TRAITÉE 


B 0 3Jfoj£2 18 16 20 30 29] 36 u8 39 58 59 70 59 61 70 74 RESULTAT 


3 03 10 [22 18 16 20 30 29|36 48 39 58 59 70 59 61 70 74 
30 3 1020 18 16](22]Bo 29] 36 u8 39 58 59 70 59 61 70 74 


TRI FINAL PAR INSERTION 
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Le k QUICKSORT (d'apres HOARE adapte par B.BESSE) 

D * 74158 ...... 12 ....3 6 162 

40 ! ! ! ! ! 

50 GAUC L MILIEU J DROI 

60 ! 

70 DÉFINT A-Z:T=256:DIM V(T) 

90 Sequence d'essai 

100 FOR I=1 TO T:V(I)=RND(1)#1000:NEXT I " Remplissage de V() avec nb aleatoires 
105 PRINT "TOP" 

120 

130 DIM PILE(1,14) " Pile pour stockage des adr des partitions a traiter 
150 PPILE=0 " Pointeur pile 

160 LINF=10 " Limite inférieure de partition 

170 ! 

180 IF T=1 THEN 660 

190 IF T<=LINF THEN 540 

200 ‘ 

210 GAUC=1:DROI=T 

220 Choix de l'element de reference pour la partition 
230 MILIEU=INT((GAUC+DROI)/2) 

250 IF V(GAUC)<V(MILIEU) THEN SWAP V(GAUC) ,V(MILIEU) 

260 IF V(DROI)<V(GAUC) THEN SWAP V(DROI) ,V(GAUC):IF V(GAUC)<V(MILIEU) THEN SWAP V(G 
AUC) ,V(MILIEU) 

280 Partition 

290 REF=V(GAUC) : I=GAUC:J=DROI+1 

310 ! 

320 I=I+1:IF V(I)<REF THEN 320 

330 ‘ 

340 J=J-1:1F V(J)>REF THEN 340 

350 ‘ 

360 IF I<J THEN SWAP V(I),V(J):GOTO 320 

370 

380 SWAP V(GAUC) ,V(J) 

OO Chargement de la pile 

410 IF (J-GAUC)>(DROI-J) THEN 470 

420 Partition gauche la + petite 
430 IF (J-GAUC)>LINF THEN PPILE=PPILE+1:PILE(O,PPILE)=J+1:PILE(1,PPILE)=DROI:DROI=J 
-1:GOTO 230 

U4O IF (DROI-J)>LINF THEN GAUC=J+1:GOTO 230 

450 GOTO 500 

460 1 Partition Droite la + petite 
470 IF (DROI-J)>LINF THEN PPILE=PPILE+1:PILE(O ,PPILE)=GAUC:PILE(1,PPILE)=J-1:GAUC=J 
+1:GOTO 230 

480 IF (J-GAUC)>LINF THEN DROI=J-1:GOTO 230 

49O On retire de la pile 

500 IF PPILE=0 THEN 540 

520 GAUC=PILE(O, PPILE) :DROI=PILE(1,PPILE) : PPILE=PPILE-1:GOTO 230 

530 Tri final par insertion 

540 IF V(1)>V(2) THEN SWAP V(1),V(2) 

550 IF T=2 THEN 660 

560 FOR N=3 TO T 

570 IF V(N)>=V(N-1) THEN 630 

580 SWAP V(N) ,V(N-1) 

590 FOR K=N-2 TO 1 STEP-1 

600 IF V(K)<=V(K+1) THEN 630 

610 SWAP VCK),V(K+1) 

620 NEXT K 

630 NEXT N 

640 1 Edition des resultats 

660 FOR K=1 TO T:PRINT V(K):NEXT K 

670 

680 ' 32 s pour 256 nombres aleatoires.20s pour liste triee où inverse 
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10 
30 
50 
60 
65 
80 
90 
100 
120 
130 
140 
150 
160 
170 
180 
190 
200 
210 
220 
240 
250 
260 
270 
280 
290 
300 
310 
320 
330 
340 
350 
360 
370 
380 


10 

30 

40 

50 

80 

90 

100 
120 
130 
140 
150 
160 
180 
190 
200 
210 
220 
230 
240 
250 
260 
270 
280 
290 
300 
310 
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"QUICKSORT (element reference choisi a gauche et sans tri final) 
DEFINT A-Z:T=256:DIM V(T+1) 

ie — Sequence d'essai 

FOR 1=1 TO T:V(I)=RND(1)#1000:PRINT V(I);:NEXT I 


V(0)=2-10000 : V(T+1)=10000 " Bornes 

l nsc icosnéeniseis 
DIM PILE(1,14) ‘ Pile pour stockage des adr des partitions a traiter 
PPILE=0 " Pointeur pile 

GAUC=1:DROI=T 

Tossmosessadec 

IF DROI<=GAUC THEN 320 

a Partition 

REF=V(GAUC) : I=GAUC:J=DROI+1 

! 

I=l+1:IF V(I)<REF THEN 180 

{ ] 

J=J-1:IF V(J)>REF THEN 200 

! 

IF I<J THEN SWAP V(I),V(J):GOTO 180 

SWAP V(GAUC) ,V(J) 

DER RRERR RRR ER Chargement de la pile 

IF (J-GAUC)>(DROI-J) THEN 300 

ln nm mm mm mm mm Partition gauche la + petite 
PPILE=PPILE+1:PILE(O,PPILE)=J+1:PILE(1,PPILE)=DROI :DROI=J-1:GOTO 140 

ln in nn SEL insomnie Partition Droite la + petite 

PPILE=PPILE+1:PILE(O,PPILE)=GAUC:PILE(1,PPILE)=J-1 : GAUC=J+1:GOTO 140 
LE SES On retire de la pile 

IF PPILE=0 THEN 350 

GAUC=PILE(O ,PPILE) :DROI=PILE(1,PPILE) : PPILE=PPILE-1:GOTO 140 

Pr ne Edition des resultats 

FOR K=1 TO T:PRINT V(K);:NEXT K 

L 

" HO sec pour 256 nombres aleatoires.Diverge pour liste triee ou inverse:360s 
" QUICKSORT (el ref choisi au milieu et sans choix de la partition a traiter) 
DEFINT A-Z:T=256:DIM V(T+1) 


LEE EURE Sequence d'essai 
FOR I1=1 TO T:V(I)=RND(1)#1000::NEXT I 
DIM PILE(1,20) ‘ Pile pour stockage des adr des partitions a traiter 
PPILE=0 ! Pointeur pile 
GAUC=1:DROI=T 


a — Partition 
REF =V(INT((GAU+DROI)/2)):I=GAUC:J=DROI 
LU 


IF V(I)<REF THEN I=1+1:GOTO 190 
U 


IF V(J)>REF THEN J=J-1:GOTO 210 

' 

IF I>J THEN 270 

SWAP VCI),V(J):I=l+l:J=J-1:IF I<=J THEN 190 


a Chargement de la pile 

IF I<DROI THEN PPILE=PPILE+1:PILE(O,PPILE)=1:PILE(1,PPILE)=DROI 
DROI=J:GOTO 140 

a On retire de la pile 

IF PPILE=0 THEN 330 

GAUC=PILE(O ,PPILE) :DROI=PILE(1,PPILE) :PPILE=PPILE-1:GOTO 140 
a Edition des resultats 


" 45s pour 256 nombres aleatoires.26s pour liste triee et inverse 
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COMPARAISONS DES TRIS 


Lorsque le nombre d'éléments à trier est inférieur à 50, 
toutes les méthodes de tri sont pratiquement équivalentes. ; 
On choisira donc dans ce cas la plus simple à écrire. 


Au-delà de 50, Shell, Shell-Metzner et Quicksort se démarquent 
très nettement. 


T 


RIPPLE - BUBBLE- PER ration : OÙ N4 
INSERTION 


seu: @N 4-25 
SeLL-METBNER : P/> w125 


QUICKSORT 
N 


© 400 200 


# conditions D'Essais: NOMBRES ALEATOIRES 
ENTRE @ ET 4 


TRI DE CHAINES DE CARACTERES 


On sait qu'en Basic Microsoft, il est réservé un espace 
particulier pour les chaînes de caractères (par CLEAR xxx). 


On observe qu'avec l'instruction SWAP, les chaînes de 
caractères ne sont pas déplacées alors qu'au contraire, 
l'échange de deux chaînes par : 


X$=AS$(I):AS$S(I)=A$(I+1):A$(I+1)=X$ 
provoque une réallocation des chaînes. 


Par conséquent, il y a périodiquement réorganisation de 
l'espace chaîne et donc un temps d'attente non négligeable 
qui vient s'ajouter au temps de tri lui-même. Plus le taux 
d'occupation pour les chaînes est faible, moins les réorganisa- 
tions sont fréquentes. 


L'échange de deux chaînes X$# et Y$#, sans SWAP, peut être fait 
par l'échange des descripteurs de chaînes. Ces descripteurs 


comportent trois octets qui représentent la longueur et l'adresse 
des chaînes. 


100 AX=VARPTR(X$):AY=VARPTR(Y$) 

110 FOR I=0 TO 2 

120 X=PEEK(AX+I):POKE AX+I,PEEK(AY+I):POKE AY+4I,X 
130 NEXT I 


En "développant' la boucle 'FOR', l'échange des descripteurs 
serait plus rapide. 
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10 '"TCHAI TRI DE CHAINES DE CARACTERES SANS 'SWAP' 

20 

30 On observe que les chaines sont deplacees en memoire centrale 
yo ! 

50 ! 


60 CLEAR(100) 

70 FOR 1=1 TO 5 

80 A$(I)=STRING$("A",6-I) " A$(1)='AAAAA' 

90 LPRINT A$(I) 

100 NEXT I 

110 LPRINT 

0 TRI 
130 FOR I=1 TO 5-1 


140 FOR J=1+1 TO 5 
150 IF A$(I)>A$(J) THEN X$=A$(I):A$(I)=A$(J):A$(J)=X$ 
160 NEXT J 
170 
180 LPRINT " adr descr L adr chaine":LPRINT 
190 FOR K=1 TO 5 " Visualisation des descripteurs de chaines 
200 X=VARPTR(A$(K)):LPRINT K; TAB(5);X;PEEK(X);PEEK(X+2);PEEK(X+1);A$(K) 
210 NEXT K 
220 LPRINT 
230 NEXT I 
AAAAA 
AAAA 
AAA 
AA 
A : 
JESCRIPTEURS 
adr deser L adr chaine De chaines Pour Aÿ() 
DS D Gba MU) pr cas 
3 30923 4 191 215 AAAA 29 PARAIT 2 Éd 
4 30926 3 191 207 AAA 
5 30929 2 191 202 AA 
adr descr L adr chaine 
1 30917 1 191 204 A 
2 30920 2 191 172 AA 
3 30923 5 191 (88) aAAAA 
4 30926 4 191 177 AAAA 
5 30929 3 191 169 AAA 
adr descr L adr chaine 
1 30917 1 191 254 A 
2 30920 2 191 252 AA 
3 30923 3 191 228 AAA 
L 30926 5 191 235 AAAAA 
5 30929 4 191 224 AAAA 
adr descr L adr chaine 
1 30917 1 191 254 A 
2 30920 2 191 252 AA 
3 30923 3 191 228 AAA 
4 30926 4 191 215 AAAA 
5 30929 5 191 210 AAAAA 
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TRIS MULTICRITERES 


On veut obtenir, à partir d'un fichier client, une liste 
triée de ceux-ci pour chaque département. 


Une méthode simple consiste à effectuer un tri en prenant 
comme clé la concaténation du département et du nom. 


Si des zones numériques qui n'ont pas un nombre de chiffres 
constant (mois de naissance par exemple) doivent être concaténées 
avec des chaînes, il ne suffit pas de les convertir par STR$. 

En effet, elles seraient cadrées à gauche. 


12MARTIN serait considere comme plus petit que 3DUPONT 
On fait donc : 


CLE$=RIGHTS$ (" "+STR$ (MOIS) ,2)+NOM$ 


3 {DUPONT 


12 {MARTIN 


FICHIER 
fcamana [ax [76 | 
x rsoseuer he 144 | 
[_] 


RQ CONCATÉNATION 
Du DEPARTEMENT ET DU Nom 
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10 

20 

30 

140 
160 
170 
180 
190 
200 
210 
220 
230 
240 
250 
260 
270 
280 
310 
320 
330 
340 
350 
360 
370 
380 
390 
400 
410 
430 
440 
450 
460 
470 


480 
490 
500 
510 


! 
! 
' 
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TRIMU 16.11.80 TRI MULTICRITERES 


NOM$ : Nom defini dans fichier 'CLIEN' 15 c 
DEPART$ : Departement defini dans fichier 'CLIEN' 2 ce 


! 
L 
L 
® 
OPEN "R" ,1,"CLIEN" * Ouverture du fichier 'CLIEN' 
U 


FIELD #1,15 AS NOM$,12 AS PRENS$,20 AS TEL$,2 AS DEPART$ 


: CONSTITUTION DES TABLES CLE$() ET INDEX() 

NCLES =0 " NCLES: Nombre de cles 

NB=LOF(1):DIM CLE$(NB) ,INDEX(NB) ! Tables des CLES et d'INDEX 

! 

FOR I=1 TO LOF(1) " Lecture de tout le fichier 
GET #1,1:IF ASC(NOM$)=0 GOTO 330 " Lecture de l'enregistrement I 


NCLES=NCLES+1 : CLE$ (NCLES )=DEPART $+NOM$: INDEX (NCLES )=I 
PRINT CLE$ (NCLES) 
NEXT I 
lisses essessepasiiieshirotein étions héartanté sions tie téstts piton hiaree tés thin hisser sh ce eue 
TAILLE=NCLES " TRI des tables CLES$() et INDEX() 
FOR I=1 TO TAILLE-1 ! (par permutation d'indices) 
PPETIT=I 
FOR J=I+1 TO TAILLE " Recherche du plus petit de I a TAILLE 
IF CLE$(J)<CLE$(PPETIT) THEN PPTIT-J 
NEXT J 
NEXT I 


LPRINT "Liste des NOMS tries par DEPARTEMENT" 
L=LEN (DE PART$) 
FOR I=1 TO NCLES 
IF LEFT$(CLE$(I),L)<>LEFT$(CLE$(I-1),L) THEN 
LPRINT:LPRINT "Departement :";LEFT$(CLES$(I),L):LPRINT 
GET #1,INDEX(I) 
LPRINT TAB(5) NOM$,PRENOM$,TEL$ 
NEXT I 
' 


Liste des NOMS tries par DEPARTEMENT 


Departement :77 


SOUQUET Cecile 888-99-00 


Departement : 78 


CAMARA Leon 666-99-88 
DUPONT Jean 7717-55-44 
PASQUEREAU Alain 739-33-90 


Departement :91 


SEHAN Francois 665-13-87 
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CHAPITRE 4 
GESTION D'ECRAN 


ADRESSAGE DIRECT SUR ECRAN 


Les instructions PRINT provoquent une édition continue sur 
l'écran. Les informations du haut de l'écran disparaissent 
donc au fur et à mesure de l'exécution de PRINT. 


En revanche, l'adressage direct sur écran n'affecte celui-ci 
qu'aux endroits prévus. 


TRS-80 : 

Sur TRS-80, l'adressage direct se fait à l'aide de PRINT @ : 

#4 
y=S # 

10 X=10 " 10 eme colonne 
20 Y=5 " 5 eme ligne 
30" Je suis LA 
40 print @Y*64+X,"JE SUIS LA" 
MICROSOFT 5. : # ADReSsagE DIRECT 


I1 n'existe pas pour le langage Basic Microsoft 5. de fonction 
d'adressage direct explicite. 


C'est par l'envoi d'un caractère de contrôle immédiatement 
suivi des coordonnées X et Y qu'est assuré l'adressage direct 
curseur. 


100 CUR=XX Valeur specifique a chaque type d'ecran 
110 ! 
120 X=10:Y=5 ‘ Abscisse :ordonnee 


130 PRINT CHR$(CUR)+CHR$(X)+CHR$(Y);"JE SUIS LA" 


[oursPrs s| JE SUIS LA \ 


Les trois caractères avant le texte sont 'interprétés' par 
l'écran et ne sont bien sûr pas imprimés. 
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Il est souvent plus pratique de définir une fonction d'adressage 
curseur qu'il suffit ensuite d'appeler à chaque fois qu'un 
adressage direct est nécessaire : 


50 DEFFNCUR$(X,Y)=CHR$(CUR)+CHR$(X)+CHR$(Y) 
60! 
100 PRINT FNCUR$(10,5);"JE SUIS LA" 


AFFICHAGE D'UN ENREGISTREMENT A L'ECRAN 


Soit à afficher sur l'écran différentes zones d'un enregistre- 
ment de fichier Random, nous définissons dans différentes tables 
les paramètres suivants : 


- les libellés des zones : table LIBS() 


- les types des zones du fichier Random : 
1 -2 Chaînes de caractères : table TYPE() 
2 --) Entiers 
3 - Simple précision 


- les coordonnées d'affichage des libellés : tables XLIB() et 
YLIB() 


Nous choisissons d'afficher la zone elle-même avec une marge 
de 30 par rapport au libellé plutôt que de définir des coordon- 
nées supplémentaires pour celle-ci. 


XLIB() YLIB() LIB$() TYPE 


REFERENCE 1 ZNE$(1) ZNE$(2) ZNE$(3) 


1 
2 Rs [vorrure XXX} 20000 LUN 


Enregistrement de fichier RANDOM 


EErErE+E 


= oO D 


REFERENCE : Rs 
LiBELLE : VOITURE 
PRixX ACHAT : 2ooo0o 
PRix VENTE : 24000 


mans 30, 


10 GOSUB 100:STOP 

20 t—…_—…mmmm—— 

100 FOR P=1 TO N 

110 PRINT FNCUR$(XLIB(P),YLIB(P));:PRINT LIB$(P); ‘ Affichage libelles zones 
120 PRINT FNCUR$(XLIB(P)+30,YLIB(P)); 

130 ON TYPE(P) GOSUB 1000,1010,1020,1030 " Affichage contenus zones 
200 NEXT P 

210 RETURN 

220 

210 ! 

1000 PRINT ZNE$(P):RETURN " Chaines 

1010 PRINT CVI(ZNE$(P)):RETURN ‘ Entiers 

1020 PRINT CVS(ZNE$(P)):RETURN ‘ Simple-precision 
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VIDEO INVERSE 


La vidéo inverse qui permet de mieux distinguer certaines 
zones existe maintenant sur la plupart des écrans. Elle se 
programme ainsi : 


100 PRINT CHR$(VIDEO); "REFERENCE :" ; CHR$(FINVIDEO) ;REF$ 


SAISIE CARACTERE PAR CARACTERE 


La saisie par INPUT ne permet pas de contrôler par programme 
un caractère dès sa frappe au clavier; il faut attendre que 
l'opérateur ait frappé un "retour chariot' pour analyser la 
ligne frappée et détecter une éventuelle erreur de frappe. 


En revanche, INKEYS sur TRS-80 et INPUTS(1) en MICROSOFT 5. 
fournissent au programme un caractère juste après sa frappe. 


Mais dès lors qu'une saisie est faite caractère par caractère, 
il appartient au programmeur de gérer tous les caractères frappés, 
y compris le caractère 'curseur gauche' et 'retour chariot', 
transparents avec l'instruction INPUT classique. 


En outre, les caractères frappés ne sont pas imprimés par 
Basic, c'est le programmeur qui doit les imprimer (s'ils sont 
valides). 


TRS80: 


100 GOSUB 1000 :STOP ‘ Resultat dans LIGNES 
110; Ma ne 


1000 LIGNE$="" 
1005 
1010 C$=INKEYS$:IF C$="" THEN 1010 ‘ Attente d'un caractere 
1020 
1030 C=ASC(C$) :L=LEN(LIGNES$) 
1040 IF C=8 THEN IF L>0 THEN LIGNES$=LEFT$(LIGNES$,L-1) ELSE 1010 ' Curseur gauche? 
1050 IF C=13 THEN RETURN " Retour chariot? 
1060 LIGNES$=LIGNES+C$ 
1070 PRINT Cf; 
1080 GOTO 1010 
Remarque : avec INKEY$, le curseur écran n'apparaît plus. 


MICROSOFT 5.: 


La ligne 1010 devient : 
1010 C$=INPUT$(1) 


Attention ! Le Basic Microsoft 5. envoie un retour chariot 
après l'impression de 80 caractères si aucun retour chariot 

n'a été programmé. Par conséquent, lors d'une saisie d'écran 
caractère par caractère, il faut, soit envoyer des retours 
chariots à l'écran périodiquement, soit programmer une longueur 
de ligne ‘'infinie' par l'instruction WIDTH 255. 


GENERATEUR DE SAISIE D'ECRAN 


Nous vous avions présenté une saisie d'écran où les diffé- 
rents paramètres de saisie (coordonnées des zones à saisir, 
longueur, type,..) étaient définis dans des tables. Nous vous 
proposons de définir ces paramètres de façon plus visuelle en 
‘'dessinant' l'écran, par l'intermédiaire de DATA. 
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Un programme analyse ces DATA et documente des tables XLIB(), 
YLIB(), LGEUR(), TYPE(), MG(). L'analyse des DATA se fait 
ligne par ligne à l'aide de la fonction INSTR qui permet de 
retrouver la position d'un caractère dans une chaîne : 


- la première DATA de chaque ligne représente le numéro de 
ligne à l'écran. Son interprétation est immédiate. 


- pour repérer le début et la fin de chaque libellé de zone, 
nous avons choisi les caractères # et(o). 


HReference@ 
— la longueur et le type de zone sont définis ainsi : 
$CCCCCC*# 


Sur cet exemple, la zone est du type chaîne et doit avoir une 
longueur maxi de 6. 


- la reconnaissance du type de zone se fait par : 
X=INSTR("CIS",X$) qui fournit X=1,2,3 selon que X$ est C,I,S 


(C=chaines I=integer S-=simple precision) 


Nous générons ensuite le FIELD# du fichier Random où les résul- 
tats de la saisie seront rangés. Notons que l'interprétation 
des DATA est faite à chaque exécution du programme. 

nee 


Re 
Reference:  ............. \ 
Libelle: dés oie scie ns 61516.» 6 6,6 0160/0010 0.0.0 
Prix achat: --- Prix vente: ——-— 


ZNE$(1) ZNE$(2) ZNE$(3) 


Enregistrement de fichier RANDOM 


Détails sur la saisie : le retour sur une zone arrière, en 
cours de saisie, se fait par la touche de code 26 (à adapter 
au clavier). 


1/ Nous affichons une grille de saisie en indiquant par des 

".' ou des '-', suivant le type de zone, le nombre de caractères 
maximum à saisir. Eventuellement, l'ancien contenu de l'enre- 
gistrement peut être visualisé (il ne l'est pas sur l'exemple). 


2/ Nous saisissons ensuite les informations caractère par 
caractère en respectant bien entendu la grille précédemment 
affichée. 


Lorsque, en cours de saisie, l'opérateur appuie sur la 
touche "curseur gauche', nous remplaçons le dernier caractère 
frappé par un '.' ou un '-' selon le type de zone. 


1730 IF ... THEN PRINT CHR$(8);CA$;CHR$ (8); " CA$="." ou "-" 
Remarque : En Microsoft 5., l'impression de caractère sans RC 


(par PRINT C$;) provoque l'envoi automatique d'un RC tous les 
120 caractères. 
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Adaptation TRS-80 : la fonction FNCURS est remplacée par PRINT@ 


C$=INPUTS (1) est remplacé par : 1700 C$=INKEY$:IF C$="" THEN 1700 


La gestion du curseur écran peut se faire par : 

1370 SET(XLIB(P)+MG(P)-1)#2,YLIB(P)#3+1:GOSUB 1640 " Allumage curseur ligne 
1375 RESET(..,..) " Extinction curseur ligne 
Sur TRS-80, l'impression de CHRS(8) provoque l'effacement du 
dernier caractère affiché à l'écran, on fait donc : 

1730 IF C=8 .. THEN .. PRINT CHR$(8);CA$;:PRINI @XY+L-1,""; 


1660 XY=YLIB(P)#64+XLIB(P)+MG(P) " Calcul de X,Y debut de zone 


1660 PRINT @XY,""; ‘ Positionnement debut de zone saisie 
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SAisie > PLUSIEURS ZoNEs 


ARiCHAÇE 


À 0 Saisie D'UNE Ligne 
GRILLE SAISIE 


SAisie D'un 


APPEL SAÏSIE 
D'UNE LIGNE 


RON 


coÿe 267 


> 


ImPRession Du 
CARACTERE ACQUIS 


LiQNEZ = LIQNES + CS 
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82 'SAIZ GENERATEUR DE SAISIE D'ECRAN 
84 ! 

86 OPEN "R",#1,"HAS" 

90 EF$=CHR$(31) ‘ Effacement ecran (a adapter) 

100 Dessin de l'ecran 

120 ' NLIG pl pe p3 p4 

130 ! ! ! ! ! 

140 ! v v v v v 

150 DATA 1," Non : :@ $CCCCCCCCCC#" 

160 DATA 3," Prenom: :@ $CCCCCCCCCCCCCCCCCCCCCCCCCCC#!" 

170 DATA 5," Matricule :@ $SSSSS* #Telephone : :@ $CCCCCCCCC# 

180 DATA 99 

190 1 Constitution de LIB$() XLIB() YLIB() LGEUR() TYPE() MG() 
200 P=1 

210 ‘ 

220 READ NLIG:IF NLIG=99 THEN N=P-1:GOTO 350 " Lecture du no de ligne ecran 
230 READ LIGNE$:DB=1 " Lecture d'une ligne ecran 
240 

250 P1=INSTR(DB, LIGNES ,"#") : P2=INSTR(DB,LIGNE$,"@") 
260 P3=INSTR(DB,LIGNES$,"$") : PU=INSTR(DB,LIGNES$,"*") 
270 YLIB(P)=NLIG:XLIB(P)=P1 

280 LIB$(P)=MID$(LIGNES$,P1+1,P2-P1-1) 

290 LGEUR(P)=P4-P3:MG(P)=P3-P1 

300 X$=MID$(LIGNES,P3+1,1) 


Debut et fin du libelle 
Debut et fin zone a saisir 
Coordonnees du libelle 
Libelle 

Longueur de saisie 

Type de zone C,I,S 


310 X=INSTR("CIS" ,X$) : TYPE(P)=X " 1:chaines 2:Integer 3:Simple precision 
320 P=P+1 

330 IF INSTR(P4,LIGNES$,"#")=0 THEN 220 ELSE DB=P4+1:GOTO 250 

340 Generation du FIELD# 

350 D=0 


360 FOR I=1 TO N 

370 IF TYPE(I)=2 THEN FIELD #1,D AS D$,2 AS ZNE$(I):D=D+2:GOTO 400 
380 IF TYPE(I)=3 THEN FIELD#1,D AS D$,4 AS ZNE$(I):D=D+4 :GOTO 400 
390 FIELD #1,D AS D$,LGUEUR(I) AS ZNE$(I):D=D+LGUEUR(I) 


4OO NEXT I 

410 DEF FNCUR$(X, Y)=CHR$(16)+CHR$(31+Y)+CHR$(31+X) ‘ Adressage curseur(a adapter 
) 

430 PRINT EF$ 

44S GET #1,1:GOSUB 1320:PUT #1,1:STOP " Essai 

1300 ‘===============================2========= SAISIE DE N ZONES DANS ZNE$() 

1310 

1320 FOR I=1 TO N:TRAV$(I)="":NEXT I " Table de travail pour saisie 

1330 GOSUB 1930 " Appel Edition grille ecran 

1340 ‘ 

1350 P=1 " P: Zone courante 1,2,3,4,..,N 

1360 

1370 GOSUB 1640 " Appel saisie de LIGNES 

1380 ON R GOTO 1420,1450 , 1400 ‘ R=1:0K /R=2:l1igne vide R=3:0n remonte 
1390 


1400 IF P>1 THEN ON TYPE(P) GOSUB 2010 ,2020,2020:P=P-1:GOTO0O 1370 ELSE 1370 ©‘ R=3 : 
on remonte 

1410 ! 

1420 ON TYPE(P) GOSUB 1500,1510,1520 " Appel rangement fichier 

1430 TRAV$(P)=LIGNES$ 

1440 ! 

1450 PRINT FNCUR$(XLIB(P)+MG(P),YLIB(P)); 

1460 ON TYPE(P) GOSUB 2010 ,2020 ,2020 " Reaffichage zone 

1470 IF P=>N THEN RETURN " Fin de saisie? 

1480 P=P+1:GOTO 1370 

1490 ! 

1500 LSET ZNE$(P)=LIGNES$: RETURN " Rangement de LIGNE$ dans BUFFER 
1510 LSET ZNE$(P)=MKIS$(VAL(LIGNES$)) : RETURN 

1520 LSET ZNE$(P)=MKS$(VAL(LIGNES$)) : RETURN 

1530 SAISIE D'UNE LIGNE 


1630 
1640 
1650 
1660 
1670 
1680 
1690 
1700 
1710 
1720 
1730 
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7 SAISIE D'UNE LIGNE dans LIGNES 
LIGNE$="" 

IF TYPE(P)=1 THEN CA$="." ELSE CA$ÿ="-" 

PRINT FNCUR$(XLIB(P)+MG(P) ,YLIB(P)); 

L 


L Curseur gauche:8 /Retour chariot:13 / Zone arriere:26 
! 


C$=LCHR$(98) " Lecture d'un car au clavier (INPUT$(1) ou INKEY$) 
C=ASC(C$) :L=LEN(LIGNES$) 
L 


IF C=8 THEN IF LIGNE$<>'"" THEN LIGNE$=LEFT$(LIGNES,L-1): PRINT CHR$(8);CA$;CH 


R$(8);:GOTO 1700 ELSE 1700 


1740 
1750 
1760 
1770 
1780 
1790 
1800 
1810 
1820 
1830 
1840 
1850 
1910 
1920 
1930 
1940 
1950 
1955 
1960 
1970 
1980 
1990 
2000 
2010 
2020 
2021 
2022 
2023 
2024 
2030 
2040 
2050 
2060 
2070 
2080 
2090 
2100 
2110 
2120 


IF C=13 THEN IF LIGNE$<>"" THEN R=1:RETURN ELSE R=2:RETURN 

IF C=26 THEN R=3:RETURN " Retour zone arriere? 
ON TYPE(P) GOSUB 1820,1830,1830:ON R GOTO 1770,1700 " Appel controle 
PRINT C$; " Affichage car frappe 
LIGNES$=LIGNE$+C$ 

IF L+13=LGEUR(P) THEN R=1:RETURN " Fin de zone? 

GOTO 1700 

! 


IF C=»>32 THEN R=1:RETURN ELSE PRINT CHR$(7);:R=2:RETURN " Controle 
IF C>47 AND C<58 OR C=46 THEN R=1:RETURN ELSE PRINT CHR$(7);:R=2:RETURN 
' 


! AFFICHAGE GRILLE 
FOR P=1 TO N " N zones 
PRINT FNCUR$(XLIB(P),YLIB(P)); 
PRINT LIB$(P); 
ON TYPE(P) GOSUB 2022,2023,2024 " Anciennes zones 
PRINT FNCUR$(XLIB(P)+MG(P),YLIB(P)); 
ON TYPE(P) GOSUB 2010,2020 ,2020 
NEXT P 
RETURN 
LU 
PRINT TRAV$(P);STRING$("." ,LGUEUR(P)-LEN(TRAV$(P))) : RETURN 
PRINT TRAV$(P); STRING$("-",LGUEUR(P)-LEN(TRAVS$(P))) : RETURN 
! 


IF ASC(ZNE$(P))<>0 THEN TRAV$(P)=ZNE$(P):RETURN ELSE RETURN 
X$=STR$(CVI(ZNES$(P))):TRAV$(P)=LEFT$(X$, LEN(X$)-1) : RETURN 


' LIB$() : Table des libelles de zones 

! XLIB() YLIB() : Coordonnes des libelles 

! LGEUR() : Longueur des zones(saisie) 

L MG() : Marge par rapport a X du libelle 
! TYPE() : Type de zones (C,I,S) 

L 


" ASSOCIER CE PROGRAMME AVEC 'HASH' pour obtenir un programme de saisie 
" avec acces par cle. 
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CHAPITRE 5 
PROGRAMMES 


FACTURATION 
(cf. Hash-Code et allocation dynamique) 


Nous allons montrer sur cet exemple relativement complexe 
(3 fichiers : clients, produits, factures avec accès par clé) 
comment on peut, par une programmation modulaire, se passer 
d'organigramme. 


11 s'agit de constituer des factures en se servant d'un fichier 
client et d'un fichier produit. Ces factures sont ensuite enre- 
gistrées dans un fichier, leur édition se faisant ultérieurement. 


L'ensemble des fichiers doit être géré dynamiquement, c'est-à- 
dire, qu'il n'y a pas de mode création explicite pour ajouter 
un nouveau client ou un nouveau produit. En cours de saisie 
d'une facture, deux sous-programmes sont chargés de rechercher 
les clients ainsi que les produits et de les créer dynamiquement 
s'ils n'existent pas. Ceci évite à l'opérateur de vérifier, 
avant une facturation, si le client et les produits existent 
déjà. 


Nous avons prévu un accès par clé pour les clients, les 
produits et les factures. La méthode utilisée (cf. Hash-Code 
et allocation dynamique) assure en outre la gestion de l'allo- 
cation dynamique, c'est-à-dire, qu'à chaque fois qu'un client, 
un produit ou une facture sont supprimés, la place qu'ils 
occupaient est récupérable pour un ajout ultérieur. 


Faut-il dans le fichier des factures, placer directement les 
noms des clients et les noms des produits ou des pointeurs vers 
les enregistrements vers ceux-ci ? 


La seconde méthode a l'avantage d'économiser de la place. 
En effet, deux octets suffisent pour coder un numéro d'enre- 
gistrement. En outre, il n'est pas nécessaire de rechercher 
les enregistrements des fichiers client et produit via les 
tables d'index, lors d'une édition de facture par exemple. 


11 faut cependant prendre garde que des clients ou produits 
vers lesquels des factures pointeraient ne soient supprimés 
et que d'autres viennent prendre leur place. 
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Une protection consisterait à gérer des pointeurs 'récipro- 
ques'. Avant de supprimer un client, on s'assurerait en temps 
réel qu'il n'existe pas de pointeur vers au moins une facture, 
ces pointeurs étant bien entendu supprimés lorsque les factures 
sont soldées. 


FICHIER CLIENTS 


ag Lrartinl xx xx [297 41410] pointeurs vers 


LES FACTURES De MARTIN 


FICHIER FACTURES 


Compte tenu du caractère simple que nous avons voulu donner 
à cet exemple, nous écrivons directement le nom du client et 
des produits dans la facture. 


Les suppressions de clients et de produits ne pourront guère 
être faites qu'en différé en tenant compte des factures. 


CLIENTS PRODUITS 


[martin [rx | [vis] xxx | 


FACTURES 


Une méthode d'accès par clé plus simple consisterait à 
rechercher celle-ci par un balayage séquentiel du fichier. 
Ceci, au détriment du temps d'accès. 

INPUT "Produit? ";PX$ 

GOSUB PRODUIT 

STOP 


PRODUIT:FOR I=1 TO LOF(2) 


GET #2,1 | 
IF PX$=REF$ THEN Q=1:PRANG=I:RETURN " La cle existe 
NEXT I 
PRANG=LOF (2)+1:Q=2:RETURN " La cle n'existe pas 


* Allocation en fin de fichier 
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Avec ce système, l'allocation dynamique n'est bien sûr pas 
assurée, c'est-à-dire, que si un produit est supprimé, la place 
qu'il occupait ne sera pas récupérable pour un nouvel ajout. 
C'est volontairement, afin de ne pas surcharger le programme 
(et ainsi de mieux faire apparaître l'essentiel), que nous 
n'avons pas traité l'édition de la facture comme il conviendrait 


de le faire pour un cas réel. 

Nous n'avons pas fait figurer le listing des sous-programmes 
de recherche/création des produits et des factures. Ils corres- 
pondent quasiment à ceux de la recherche/création client, aux 
noms de variables près. 

Remarquons que les clients sont créés non seulement dynami- 
quement (en cours de facturation), mais également directement 
(mode MC), les sous-programmes de saisie étant bien entendu 
communs. Il en va de même pour les produits. 


FACTURATION 
EE 


FICHIER CLIENTS Fichier PRODUITS 


SAUVEGARDE De 


Sel D chAsHh 70) 


5 FACTURATION 


FicHieR FACTURES 
SAUVEGRRIE De FHAHX 


# ETABLISSEMENT D'UNE FACTURE 
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FACTURATION (architecture du programme) 


MODE: INPUT “Mode? ";M$ 
IF M$="F" THEN GOSUB FACT 


GOTO MODE 


SOUS- PROGRAMME ‘CLIENT ? 


RECHERCHE UN CLIENT 


«Le CREE S'il N'EXISTE 
PAS 


FACT: INPUT "Client? ";CX$ 
IF CX$="" THEN RETURN 


TT ——— | RETURN 


INPUT "No facture? ";FX$ 
IF FX$="" THEN GOTO FACT 
: a || Sous - PRoçramme 'FACT" 
GOSUB FACT 
: e RECHERCHE UNE F 


eh 


FOR PD=1 TO 5 " 5 produits par facture. 
INPUT "Produit? ";PX$ 


GOSUB PRODUIT 
INPUT rie RS 
NEXT PD 
INPUT "Facture ok? O/N ";R$ 
IF R$<>"O" THEN GOTO FACT 
PUT #3,FRANG 
GOTO FACT 


GESTION DES STOCKS 


: = SAÏSIE CLIENT 
GOSUB CLIENT 


APC 


APF 


sous -ProrarHe * Produit * 


RECHERCHE UN PRODUIT 


LE cree S'il N'EXISTE 


PAS 
RETURN 


En différé : 


Les stocks peuvent être gérés en différé périodiquement en 
soustrayant les quantités livrées (fournies par les factures) 
des quantités en stock. Un indicateur (SS$) est alors positionné 
à 1 dans les factures traitées de façon à se souvenir qu'elles 
ont déjà été soustraites des stocks. 


L'avantage d'une gestion en différé est qu'il suffit, en cas 
d'incident, (coupure de tension), de reprendre le traitement 
interrompu en se servant des sauvegardes que l'on a pris soin 
de faire avant le traitement. 


GESTION des STOCKS en DIFFERE 


5000 FOR F=1 TO LOF(3) ‘ Toutes les factures 

5010 GET #3,F 

5020 IF SS$="O0" THEN GOTO 5100 " Facture deja traitee 

5030 FOR P=1 TO 5 " 5 Produits possibles par facture 
5040 GOSUB RECHERCHE-PRODUIT * Fournit PRANG 

5050 LSET STCK$=MKIS$(CVI(STCK$)-cvi(QT$(P))) ' MAJ stock 

5060 PUT #2,PRANG ‘ PRANG: Adresse de rangement produit 
5070 NEXT P 

5080  LSET SS$="0" " Facture soustraite du stock. 
5090 PUT #3,F 

5100 NEXT F 
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En revanche, les stocks ne sont pas connus en ‘temps réel' 
(Naturellement, une facture ne doit pas être supprimée du 
fichier avant d'avoir été soustraite du stock). 


En temps réel : 


Une gestion en temps réel demande quelques précautions, car, 
en cas d'arrêt intempestif de la machine, il risque de ne plus 
y avoir cohérence entre les factures et les stocks. Comment 
donc s'y retrouver dans ce cas ? 


a Es ones à 
[LE [ 200 : 150 ] | 
Mrs Lo 2 NS ENRRSRRES RER RSS | 
stock stock 
initial reel 


En plus de la zone mise à jour en temps réel, une zone 
contient un stock dit 'initial' périodiquement mis à jour en 
différé comme ci-dessus ou seulement lorsque les factures 
soldées sont supprimées du fichier. 


Si un incident survient (en temps réel), la zone stock 
‘temps réel' peut être réactualisée en différé grâce au stock 
initial et aux factures. 


On évitera de procéder à la mise à jour des stocks en cours 
de constitution de la facture. C'est seulement lorsque la 


facture sera considérée comme "bonne" que l'on procèdera aux 
mises à jour des produits. 
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40 

170 
180 
190 
200 
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230 
240 
260 
270 
280 
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300 
320 
360 
370 
380 
390 
400 
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420 
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740 
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760 
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780 
790 
800 
810 
820 
830 
832 
840 
850 
860 
870 
880 
890 
900 
910 
920 
930 
940 
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FAC 12.12.80 
FACTURATION SIMPLIFIEE SANS ACCES PAR CLE 


Les fichiers CLIENT et PRODUIT sont deja constitues 
Ce programme genere simplement des factures qui sont enregistrees 
dans un fichier des factures(en fin de fichier) 


OPEN "R'",#1,"CLIEN" 

OPEN "R'",#2 ,"PROD" 

OPEN "R'",#3,"FACT" 

"—-_---- fichier clients 

FIELD #1,15 AS NOM$,20 AS RUE$,15 AS VILLE$,5 AS CPOST$ 

lu fichier produits 

FIELD #2,12 AS REF$,25 AS LIB$,4 AS PACHA$,4 AS PVENTES,4 AS QV$,4 AS STK$ 
t——_—- fichier factures 

FIELD #3,8 AS NFACT$,1 AS JOUR$,1 AS MOIS$,1 AS AN$,15 AS PCLI$,1 AS SOLD$ 


FOR I=1 TO 5 
FIELD #3,30 AS D$,(12+2+4)#(1-1) AS D$,12 AS PPROD$(I),2 AS QT$(I),4 AS PRIX$ 
NEXT I 
LU 
Ps nm mt t an dt 2 où 0 So éd éme ete lt dés min detente eh di en etats 
L Menu 
INPUT "Mode? (F,LF,MC,.. ";M$ 
IF M$="F" THEN GOSUB 760 " Constitution d'une facture 
IF M$="LF" THEN GOSUB 1020 " Edition d'une facture 
IF M$="MC" THEN GOSUB 1720 " Modification/creation client directe 
GOTO 380 
{ LZZSSSSSSSSSSSSSSSSSSSSSZSISSSIZISZSZZZZZZZSSSSSZSZZZZZ=SZSSZZZ=ESZ======E====== 
d CONSTITUTION D'UNE FACTURE 
1 
PRINT:INPUT "Client? ";CX$ 
IF CX$="" THEN RETURN 
GOSUB 1310 ‘ Appel recherche client 
IF R=3 THEN GOTO 760 " Annulation? 


PRINT:INPUT "Facture? ";FX$ 
IF LEN(FX$)<5 THEN 760 

L 

FRANG=LOF (3) " Remt en fin de fichier LOF(3)+1 sur TRS80 
GET #3,FRANG:LSET NFACT$=FX$ 
LSET PCLI$=NOM$ 


Pointeur vers client 
! Saisie produits pour la facture. 
FOR PD=1 TO 5 " 5 produits possibles par facture 
PRINT: INPUT "Produit? ";PX$ 
IF LEN(PX$)<3 THEN 960 
GOSUB 2390 
LSET PPROD$(PD)=REF$ 
INPUT "Quantite? ";QT 
LSET QT$(PD)=MKI$(QT) 
PRINT CVS(PVENTES$);:INPUT "Prix? ";PRIX:IF PRIXC>O THEN LSET PRIX$(PD)=PVENTE 


Appel recherche produit 
Pointeur vers produit 


$ ELSE LSET PRIX$(PD)=PVENTES 'Prix standard ou non? 

950 NEXT PD 

960 PRINT:INPUT "Facture OK? O/N ";R$:IF R$<>"O" THEN RETURN 
970 PUT #3,FRANG 

980 GOTO 760 
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1010 Edition d'une FACTURE (quantite et prix) 
1020 INPUT "Facture? ";:FX$ 

1030 IF LEN(FX$)<5 THEN RETURN 

1040 FOR FRANG=1 TO LOF(3) 

1041 GET #3,FRANG 

1042 IF FX$=LEFT$(NFACT$,LEN(FX$)) THEN GOTO 1060 

1044 NEXT FRANG 

1046 PRINT "Facture n'existe pas":GOTO 1020 

1047 ! 

1050 

1060 CX$=PCLI$:GOSUB 1310:0N R GOTO 1080, 1020 " Appel recherche client 
1070 ! 

1080 GET #1,CRANG 

1090 PRINT:PRINT NOM$ 

1100 PRINT:PRINT TAB(3);RUE$:PRINT TAB(6);CPOST$;" ";VILLES$ 


1110 ! 

1120 PRINT 

1130 FOR PD=1 TO 5 " 5 produits par facture 
1140 IF ASC(PPROD$(PD))=0 THEN 1200 

1150 PX$=PPROD$(PD):GOSUB 2400 ‘ Appel recherche produit 
1160 ! 


1170 GET #2,PRANG 

1180 PRINT TAB(20);REF$,CVI(QT$(PD)); 

1190 PRINT CVS(PRIX$(PD)) 

1200 NEXT PD 

1210 GOTO 1020 

1220 ‘===2=2==2=222=2=222=2222222=222222222222=22222=222222222222222222=2222222222222222 
1260 
1270 
1290 
1300 

1310 FOR CRANG=1 TO LOF(1) 

1312 GET #1,CRANG 

1314 IF CX$=LEFT$(NOM$,LEN(CX$)) THEN R=1:PRINT NOM$:RETURN 

1316 NEXT CRANG 

1320 R=3:PRINT "Ce nom n'existe pas" ::RETURN 

1700 RETURN 

1900 

1910 

1920 

2370 "'=====2=2=22=2-2222-222222222222=2222222222=22=222=2222=2222222=222=222=22=222222222 
2380 ‘ 

239 RECHERCHE PRODUIT 

2395 " 

2400 FOR PRANG=1 TO LOF(2) 

2410 GET #2,PRANG 

2412 IF PX$=LEFT$(REF$,LEN(PX$)) THEN PRINT REF$:R=1:RETURN 

2414 NEXT PRANG 

2416 PRINT "Produit n'existe pas":R=3:RETURN 


RECHERCHE CLIENT 
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10 ' FACTU 12.12.80 
' 


20 

30 FACTURATION 

40 

50 NCLES=40 ‘Nombre de cles par enreg pour sauvegarde des tables CHA 
SH#, PHASHZ , FHASHY 

60 DIM CHASH$(NCLES) ‘ Pour FIELD#1 sauvegarde de CHASH# 

70 DIM PHASH$(NCLES) ‘ Pour FIELD#2 sauvegarde de PHASH# 

80 DIM FHASH$(NCLES) 

90 ! 

100 TCLES=NCLES#3 " Nombre de cles maxi 

110 DIM CHASH#(TCLES) " Table CHASH# pour l'acces aux clients 
120 DIM FHASH#(TCLES) " Table FHASH# pour l'acces aux factures 
130 DIM PHASHZ(TCLES) 

140 ! 


150 ‘ Sauvegarde de CHASH%,FHASH4,PHASHY dans les 3 premiers secteurs de chaque fi 
chier 
160 ! 
170 OPEN "R'",#1,"CLIEN" 
180 OPEN "R'",#2 ,"PROD" 
190 OPEN "R'",#3,"FACT" 
200 1 fichier clients 
210 FIELD #1,15 AS NOM$,20 AS RUE$,15 AS VILLE$,5 AS CPOST$ 
220 FOR I=1 TO NCLES:FIELD #1,2#(1-1) AS D$,2 AS CHASH$(I):NEXT I 
225 FIELD #1,(NCLES#2) AS I11$ 
230 '—----- fichier produits 
240 FIELD #2,12 AS REF$,25 AS LIB$,4 AS PACHA$,4 AS PVENTES,4 AS QV$,4 AS STK$ 
250 FOR I=1 TO NCLES:FIELD #2,2#(1-1) AS D$,2 AS PHASH$(I):NEXT I 
255 FIELD #2,(NCLES#2) AS I2$ 
260 1 fichier factures 
270 FIELD #3,8 AS NFACT$,1 AS JOUR$,1 AS MOIS$,1 AS AN$,15 AS PCLI$,1 AS SOLD$ 
280 FOR I=1 TO 5 
290 FIELD #3,30 AS D$,(12+2+4)#(1-1) AS D$,12 AS PPROD$(I),2 AS QT$(I),4 AS PRIX$ 
(1) 
300 NEXT I 
310 FOR I=1 TO NCLES:FIELD #3,2#(1-1) AS D$,2 AS FHASH$(I):NEXT I 
315 FIELD #3,(NCLES#2) AS 13$ 
L 


320 

330 GOSUB 1650 " Appel lecture table CHASHZ en memoire centrale 
340 GOSUB 2290 ‘ Appel lecture table FHASH# en memoire centrale 
350 GOSUB 2810 " Appel lecture PHASH# 

360 1" 
370 ‘ Menu 

380 INPUT "Mode? (F,LF,MC,.. ";M$ 

390 IF M$="F" THEN GOSUB 760 " Constitution d'une facture 

OO IF M$="LF" THEN GOSUB 1020 " Edition d'une facture 

410 IF M$="MC" THEN GOSUB 1720 " Modification/creation client directe 
420 


430 
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940 


GOSUB 1950 
LSET PCLI$=NOM$ 


FOR PD=1 TO 5 
PRINT: 


LE BASIC 


CONSTITUTION 


PRINT:INPUT "Client? ";CX$ 
IF CX$="" THEN RETURN 
GOSUB 1310 

IF R=3 THEN GOTO 760 
PRINT:INPUT "Facture? ";FX$ 
IF LEN(FX$)<5 THEN 760 

U 


Saisie produits pour 
LU 


INPUT "Produit? ";PX$ 

IF LEN(PX$)<3 THEN 960 

GOSUB 2390 ; 
LSET PPROD$(PD)=REF$ 
INPUT "Quantite? ";QT 
LSET QT$(PD)=MKI$(QT) 


ET SES FICHIERS 


D'UNE FACTURE 


Appel recherche client 
Annulation? 


Appel recherche facture(FRANG en retour) 
Pointeur vers client 


la facture. 


5 produits possibles par facture 


Appel recherche produit 
! Pointeur vers produit 


PRINT CVS(PVENTES$); :INPUT "Prix? ";PRIX:IF PRIX<>O THEN LSET PRIX$(PD)=PVENTE 


$ ELSE LSET PRIX$(PD)=PVENTE$ 'Prix standard ou non? 
950 NEXT PD 
960 PRINT:INPUT "Facture OK? O/N ";R$:IF R$<>"O" THEN RETURN 
970 PUT #3,FRANG 
980 GOTO 760 


! Edition d'une FACTURE (quantite et prix) 


INPUT "Facture? ";FX$ 

IF LEN(FX$)<5 THEN RETURN 
GOSUB 2050:O0N R GOTO 1060, 1020 
LU 


CX$=PCLI$:GOSUB 1440:ON R GOTO 1080, 1020 
' 


GET #1,CRANG 
PRINT:PRINT NOM$ 


" Appel recherche facture 


" Appel recherche client 


PRINT:PRINT TAB(3);RUES$:PRINT TAB(6);CPOST$;" ";VILLE$ 
' 


PRINT 

FOR PD=1 TO 5 
IF ASC(PPROD$(PD))=0 THEN 1200 
PX$=PPROD$(PD) :GOSUB 2570 


GET #2,PRANG 
PRINT TAB(20);REF$,CVI(QT$(PD)); 
PRINT CVS(PRIX$(PD)) 

NEXT PD 

GOTO 1020 
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" 5 produits par facture 


‘ Appel recherche produit 


1290 
1300 
1310 
1320 
1330 
1340 
1350 
1360 
1370 
1380 
1390 
1400 
1410 
1420 
1430 
1440 
1450 
1460 
1470 
1480 
1490 
1500 
1510 
1520 
1530 
1540 
1550 
1560 
1570 
1590 
1600 
1610 
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! RECHERCHE CLIENT (le cree s'il n'existe pas) 
L 
GOSUB 14UO0:ON R GOTO 1320,1340 " Appel recherche cle 
PRINT NOM$: RETURN " La cle existe 
LU 
INPUT "NOUVEAU NOM OK? ";R$:IF R$<>"O" THEN R=3:RETURN 
LSET I1$=STRING$(CHR$(0) ,NCLES#2) " Initialisation buffer avec 0 
LSET NOM$-=CX$:GOSUB 1850 " Appel saisie 
PUT #1,CRANG :CHASH#(CRANG)=CCLE:GOSUB 1590 ' Appel sauvegarde CHASHY 
GET #1,CRANG: RETURN " Rappel client(indispensable) 
a Recherche dela cle 
! 
‘ Entree:Cx$ Retour : R=1 : La cle existe /R=2 :N'existe pas 
$ CRANG : Adresse de rangement 
: NOM$ : Nom du client 
FOR I=1 TO 3:X(I1)=ASC(MID$(CX$,1,1))-64:NEXT I 
CCLE=X(1)#26#26+X(2)#26+X(3) * Calcul d'une cle numerique 
CLIB=0 " Position libre dans CHASH# 
FOR 1#=3+1 TO TCLES 

IF CHASH#(1#)=0 THEN GOTO 1550 

IF CHASH#(1#)<>CCLE THEN 1520 

GET #1,1%:1F CX$=LEFTS$(NOM$,LEN(CX$)) THEN CRANG=1#:R=1:RETURN 
' 

IF CLIB=0 THEN IF CHASH£(1#)=-32000 THEN CLIB-1% " -32000:libre 
NEXT 14 
PRINT "C'est plein'":STOP 
IF CLIB-0 THEN CLIB=1# 
R= se: CRANG=CLIB : RETURN 

a — Sauvegarde table CHASHZ (morceau modifie) 
DB= INT((CRANG-1)/NCLES) " DB: No du bloc de CHASH#Y a sauvegader(0,1,2) 
NB=DBA#NCLES:GET #1,DB+1 
FOR J=1 TO NCLES:NB=NB+1:LSET CHASH$(J)=MKI$(CHASHZ(NB)):NEXT J 


1620 PUT #1,DB+1 

1630 RETURN 

640 Lecture table CHASHZ 

1650 NB=0:IF LOF(1)=0 THEN LSET I1$=STRING$(CHR$(O) ,NCLES#2):FOR I=1 TO 3:PUT #1,1 
:NEXT I:LSET CHASH$(1)=MKI$(32000):PUT #1,1 ‘ Initialisation index avec O ASCII 
1660 FOR I=1 TO 3 

1680 GET #1,1:FOR J=1 TO NCLES:NB=NB+1:CHASH#(NB)=CVI(CHASH$(J)):NEXT J 

1690 NEXT I 

1700 RETURN 

1710 lsz=z=2===222=2222222==2SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSZISSSSSSSSSSSSSSESEEEE 
1720 INPUT "Nom? ";CX$:IF CX$="" THEN RETURN " CREATION/MODIFICATION(MC) 
1730 GOSUB 1440:ON R GOTO 1750,1760 " Appel recherche cle 

1740 " Le client existe deja 

1750 GOSUB 1850:PUT #1,CRANG:GOTO 1720 " Appel saisie/modification 
1760 '—--—------- Le client n'existe pas 

1770 INPUT "Nouveau client? (O/N) ";R$:IF R$©"O" THEN 1720 

1780 LSET I11$=STRING$(CHR$(0) ,NCLES#2) * Initialisation buffer avec O ASCII 

1790 LSET NOM$=CX$:GOSUB 1850 ‘ Appel saisie 

1800 PUT #1,CRANG 

1810 CHASHZ(CRANG)=CCLE:GOSUB 1590 ‘ Appel sauvegarde de CHASHYZ 
1820 GET #1,CRANG ‘ Rappel client (indispensable) 
1830 GOTO 1720 

180 SAISIE CLIENT/MODIF ICATION 

1850 PRINT "Rue :"; TAB(15);RUES$;TAB(4O);:INPUT X$:1F X$<@'"" THEN LSET RUE$=X$ 

1860 PRINT "Ville:";TAB(15);VILLES$;TAB(4O);:INPUT X$:1F X$@"" THEN LSET VILLE$=X$ 
1870 PRINT "Code postal:";TAB(15);CPOST$;TAB(4O);:INPUT X$:IF X$Q'"" THEN LSET CPOS 
T$=X$ 

1880 RETURN 
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" ge 
! 
' 
U 
60 oc 
! 
! 
! 


100 ! 

110 ! 

120 CLEA 

130 DIM 

140 DIM 
u 


160 DATA 
170 DATA 
180 DATA 
190 DATA 
200 DATA 
210 
220 DATA 
230 DATA 
240 DATA 
250 DATA 
260 DATA 
' 


280 DATA 

290 DATA 

300 DATA 

310 DATA 

320 DATA 
(] 


340 DATA 
350 DATA 
360 DATA 
370 DATA 
380 DATA 


' 
' 
' 
1620 
' 
' 
' 


1660 FOR 


LE BASIC ET SES FICHIERS 


1.4.81 
EDITION DE GRANDS CARACTERES et GENERATEUR de PROGRAMMES 
e programme permet: 


1/ d'editer des caracteres geants 
2/ de generer un programme qui editera ces caracteres geants 


R(3000) 
AL$(26,5) " Table ALPHABET 
X(50) 


MO # nn 
QE ELLE D 


LLLELLELE DE 
"x #n ALÿ {4 1 

ICELEPTE TT ALS Le TABLE ALS (5) 
UE] L LL . 

ULELELE LE Li 


1 | 


ULELLLE 


D Lite arme etat io mme Lecture des DATAS dans AL$(,) 
La table AL$(,) contient l'alphabet 


1=0 TO 22 " 22 lettres 


1670 FOR J=1 TO 5 " 5 lignes par lettre 


1690 N 


1720 INP 
1730 IF 
1740 IF 
1750 GOT 


READ ALS$(I,J) 
EXT J 


UT "MODE? (EGC,GP,..) ";M$ 
M$="EGC" THEN GOSUB 1770 
M$="GP" THEN GOSUB 1910 

O 1720 
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1764 

1770 PRINT:INPUT "Message? ";M$ 
1780 FOR I=1 TO LEN(M$) 

1790 X$=MID$(M$,1,1) 


1800  X(I)=ASC(X$)-64 " XO:pointeurs vers AL$(,) 
1810 IF X(I)=-32 THEN X(I)=0 

1820 NEXT I 

1830 

1840 FOR LIG=1 TO 5 " 5 lignes pour 1 caractere 
1850 FOR J=1 TO LEN(M$) " Edition d'une ligne 

1860 LPRINT AL$(X(J),LIG);" "; 


1870 NEXT J 
1880 LPRINT 
1890 NEXT LIG 
1900 GOTO 1770 
1910 
1920 PRINT:INPUT "Message? 
1930 FOR I=1 TO LEN(M$) 
1940 X$=MID$(M$,1I,1) 


GENERATEUR DE PROGRAMMES 


1950 X(I)=ASC(X$)-64 " X():pointeurs vers AL$(,) 
1960 IF X(I)=-32 THEN X(I)=0 
1970 NEXT I 


1980 INPUT "Nom programme genere? ";NP$ 
1990 OPEN "i",#1,NP$ 

2000 

2010 FOR LIG=1 TO 5 " 5 lignes pour 1 caractere 
2020 Y$=STR$(LIG)+" PRINT "+CHR$(34) 
2030 FOR J=1 TO LEN(M$) 

2040 Y$=Y$+AL$(X(J),LIG)+" " 

2050 NEXT J 

2060 PRINT #1,Y$+CHR$(34) 

2070 LPRINT Y$+CHR$(34) 

2080 NEXT LIG 

2090 CLOSE #1 

2100 GOTO 1920 


LLLLLE] LLLL EL] 
* * * 
LELLLERRELLLL:)] 
* * 
* LLLLEE EL] 


* + 


PRINT "#####% ##### 
PRINT "*# . «* 

PRINT "A###### ###### 
PRINT "*# LU 
PRINT "* LLLLEL) 


UI E & D — 
x * 
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EDITION DE BULLETINS DE PAYE 


Ce programme permet de saisir les salaires du personnel, 
d'éditer des bulletins de paie et d'obtenir différents totaux 
pour chaque catégorie de personnel (cadres, employés). Le 
récapitulatif général n'a pas été programmé. 


Ce programme, relativement simple, devrait permettre par son 
accès facile d'observer certains aspects de l'organisation des 
programmes. 


Tout d'abord, on a cherché à traiter les différentes catégo- 
ries de personnel avec un même programme, les totaux pour les 
deux catégories étant stockés dans des tables de dimension 2. 
Un indice "TYPE' que l'on positionne à 1 ou 2 permet d'accéder 
à l'élément du tableau cherché. 


Trois sous-programmes ont été définis (édition bulletin de 
paie, cumul, édition totaux) non pas parce qu'ils pourraient 
être appelés de plusieurs endroits et ainsi permettre d'écono- 
miser de la place mémoire et de la programmation mais plutôt 
par souci de clarté et de modularité. Le programme principal 
sera plus court et n'en sera donc que plus lisible. 


Il a été prévu à la fin de l'édition de chaque bulletin de 
paye la possibilité pour l'opérateur de refuser le cumul (en 
cas d'erreur de saisie par exemple). 


PARTICULARITES DE PROGRAMMATION 


Plutôt que de programmer : PRINT USING "####.##";x 
PRINT USING "##4##.##"5Y 
On aurait pu faire : FORMATS="###A #8" 


PRINT USING FORMATS;x 
PRINT USING FORMATS;Y 
L'introduction au clavier, à chaque paie, des noms du personnel 
ainsi que des salaires est fastidieuse. Si, de plus et pour une 
raison quelconque, il y a interruption du programme, toute 
l'introduction des données est à reprendre. 
Une saisie du personnel pourrait être faite dans un fichier 
séquentiel qui serait relu par programme à chaque traitement. 
OPEN FICHIER "PERSONNEL" ,No 1 


NPUT #1, NOM$ 
sa Lu D ereiees oc DUT #1; AA TRE 
INPUT #1, STATUT 


ficuice  HouevrieL ê 
TRAÏITEMENT 


GOTO $ 


Si on ne dispose pas de fichier mais qu'il reste de la place 
en mémoire centrale, les noms, salaires et statuts du personnel 
peuvent y être rangés par l'intermédiaire de DATA. 
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PROGRAMME de PAYE 


INPUT "Date ? ";DT$ 
! 
! 
DEBUT: INPUT 


INPUT 


"Prix Repas ? " 
"Prix Transport ? 
! 

MODE : INPUT "Mode? ";MODE$ 
IF MODE$="" GOTO DEBUT 


1F MODE$="CADRE" THEN 
IF MODE$="EMPLOYE" THEN 
IF MODE$="TOTCAD" THEN 
IF MODES$="TOTEMP" THEN 
GOTO MODE 


! 


NOM : INPUT "Nom? ";NOM$ 


IF NOM$="" GOTO MODE 
! 
INPUT "Paye? ";PAYE 


! 
GOSUB IMP-PAYE 


ee 


DATA DUPONT Jean ,9000,C 
DATA BERTINI Zoe ,9500,C 


—__ 


INPUT "PAYE OK? ";RP$ 
IF RP$><"O0" goto NOM 


NB(TYPE)=NB(TYPE)+1 


=. 


_— 


GOSUB CUMUL ma 


GOTO NOM 
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EAD NOMS 
READ SALAIRE 
READ STATUT 
TRAITEMENT 
GOTO j 
;PREPAS 
1; PTRANSPORT 
vs- proewble 
PRESS io TOTAL 
D 4 
TYPE=1:GOTO NOM se 
TYPE=2:GOTO NOM 7 
TYPE=1:GOSUB IMP-TOT 
TYPE=2:GOSUB IMP-TOT 
RETURN 
: nd rpaess: on 
Bvtterin de Lu 
sn. _ 
Dr br 
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10 ! Programme a usage PEDAGOGIQUE 

20 ! 

30 PRINT "PAYE 28/7/80":PRINT "" 

10 ! 

50 PLAFOND=5000 

60 CRET(1,1)= .035 " Maladie 

70 CRET(2,1)= .010 

80 CRET(3,1)= .047 " Vieillesse 

90 CRET(4,1)= .0084 ! Chomage 

100 FOR V=1 TO 4:CRET(V,2)=CRET(V,1):NEXT V 

110 CRET(5,1)=.0618 :CRET(5,2 )=0 ‘ Retraite Cadre 
120 CRET(6,1)=.0245 :CRET(6,2)=CRET(6,1) ‘ Retraite Complem 
entaire 

130 


140 DATA S.S. MAL. S/SAL. TOTAL,S.S. MAL. S/SAL PLAF,S.S. VIEL S/SAL PLAF 
150 DATA Assurance chomage ,Retraite des cadres,Retraite complementaire 
160 FOR I=1 TO 6:READ TYRET$(I):NEXT I 
170 ! 
180 DATA CADRE,EMPLOYE:FOR 1=1 TO 2:READ STATUT$(I):NEXT I 

L 


200 INPUT "Date? ";DATE$:IF DATE$="" GOTO 200 
210 PRINT "":INPUT "Prix Repas ? ";PREPAS 
220 INPUT "Transport ? "; TRANSPORT 


D MENU 
240 PRINT TAB(20);"Mode Emploi:":PRINT "" 
250 PRINT TAB(20);" (a : Bulletin Cadre" 


260 PRINT TAB(20);" E  : Bulletin Employe" 

270 PRINT TAB(20);" FC : Total Cadre" 

280 PRINT TAB(20);" FE : Total Employe" 

290 PRINT TAB(20);" Les Cadres et Employes peuvent etre Traites'" 

300 PRINT TAB(20);" dans le desordre. FC et FE peuvent etre employes" 
310 PRINT TAB(20);" a n'importe quel moment" 


320 PRINT "": INPUT "Cadre ,Employe ,Ouvrier? (C,E,FC,FE,FO,FIN) ";R$ 

330 ‘ 

340 IF R$="C" THEN TYPE=1:GOTO 410 " Aiguillages 

350 IF R$="E" THEN TYPE=2:GOTO 410 

360 IF R$="FC" THEN TYPE=1:GOSUB 1020 :GOTO 320 

370 IF R$="FE" THEN TYPE=2:GOSUB 1020:GOTO0 320 

380 IF R$="" GOTO 210 

390 GOTO 240 

400 
410 PRINT "":INPUT "Nom 2? ";NOM$ " Debut SAISIE 


420 IF NOM$="" GOTO 240 

430 INPUT "Prenom ? ";PRENOM$ 

44O INPUT "Salaire ? "; SALAIRE 

450 INPUT "Qualif  ? ";QUALIF$ 
1 


460 

470 SBRUT =SALAIRE+PREPAS: X=SBRUT-PLAFOND:IF X<O THEN X=0 

480 Z=PLAFOND:IF SALAIRE<PLAFOND THEN Z=SBRUT 

490 BRET (1)=SBRUT :BRET(2)=Z:BRET(3)=2Z 

500 BRET (4 )=SBRUT : BRET(5)=X:BRET(6)=Z 

510 R6=0 :FOR V=1 TO 6:RET(V)=CRET(V,TYPE)#BRET(V) :R6=R6+RET(V):NEXT V 
520 SIMPOS=SBRUT-R6 

530 SPAYE=S IMPO+TRANS PORT 

540 GOSUB 830 " Appel SPG impresion paye 
550 ! 

560 PRINT "":INPUT "OK ? (O,N) ";R$:IF R$="N" GOTO 410 

570 IF R$><"O" GOTO 560 " OK? peut on faire le CUMUL 
580 GOSUB 650 :GOTO 410 

590 " 

600 1" 
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640 ! 


LE BASIC ET SES FICHIERS 


SPG Calcul CUMUL 


650 TSALA(TYPE)=TSALA(TYPE)+SALAIRE 
660 TREPA(TYPE)=TREPA(TYPE)+PREPAS 
670 TBRUT(TYPE)=TBRUT(TYPE )+SBRUT 


680 
690 
700 
710 
720 ‘ 


FOR V=1 TO 6 
BASE(V,TYPE)=BASE(V,TYPE)+BRET(V) :MRET(V,TYPE)=MRET(V,TYPE)+RET(V) 
NEXT V 


730 TENUE(TYPE)=TENUE(TYPE)+R6 
740 TIMPO(TYPE)=TIMPO(TYPE )+SIMPO 
750 TTRAN(TYPE)=TTRAN(TYPE)+TRANS 
760 TNET(TYPE)=TNET(TYPE)+SPAYE 

\ 


770 


780 NB(TYPE)=NB(TYPE)+1 
790 RETURN 
' 


800 
810 ! 
820 


‘ SPG Impression paye 


830 LPRINT "":LPRINT DATES, PRENOM$, NOM$, QUALIF$,STATUT$(TYPE) :LPRINT "":LPRINT "" 
840 LPRINT "Salaire Brut " TAB(60); :LPRINT USING "#4Hf{fHif. #4"; SBRUT 


850 ‘ 


860 LPRINT "":LPRINT TAB(44) "Base" TAB(50) "Retenues ":LPRINT "" 
U 


870 
880 
890 
900 
SING 
910 


920 ! 


FOR V=1 TO 6 
LPRINT TAB(6) TYRET$(V) TAB(34) :LPRINT USING ".####f"; CRET(V,TYPE); 
LPRINT TAB(4O):LPRINT USING "##HH{fff.1f"; BRET(V);:LPRINT TAB(50):LPRINT U 
MAI HE 3 RET (V) 
NEXT V 


930 LPRINT "":LPRINT "Total des Retenues"TAB(60);:LPRINT USING "#4#Hf{Hf. #4"; R6 

940 LPRINT "Salaire NET IMPOSABLE " TAB(60);:LPRINT USING "#{#HfiHif. #4"; SIMPO 

950 LPRINT "" 

960 LPRINT "Salaire a payer" TAB(60) :LPRINT USING "##{#f#h#. #4"; SPAYE: LPRINT TAB(60) 


970 LPRINT "" 
980 RETURN 


L " SPG Impression Totaux 
LPRINT "":LPRINT "TOTAUX "; STATUTS$(TYPE);" Nombre=";NB(TYPE):LPRINT "" 
LPRINT "Salaires de base" TAB(53) :LPRINT USING "###H{h{Hifiif . #14" ; TSALA(TYPE) 
LPRINT "Indeminites de REPAS" TAB(53) :LPRINT USING "##H#}#Hih#fif. #1" ; TREPACTYPE) 
LPRINT "Salaires brut" TAB(53) :LPRINT USING "##4H{H4H4fifif. 4"; TBRUT (TYPE) 
LPRINT "":LPRINT TAB(37);"Base des retenues" ;TAB(55)"Retenues"::LPRINT "" 
! 
FOR V=1 TO 6 
LPRINT TAB(6) TYRET$(V) TAB(45) USING "##Hh#hiff. 1"; BASE(V, TYPE) ; 
LPRINT USING "#HHHFHF. HF"; MRET(V, TYPE) 
NEXT V 
' 
LPRINT "" 
LPRINT "Total Retenues";TAB(53);:LPRINT USING "##4#Hf#f{fff. ##" ; TENUE (TYPE) 
LPRINT "":LPRINT "Salaires NET IMPOSABLE " TAB(54) USING "#4#H{HHH{if. #4" ; TIMPO(TY 


RETURN 
! 


' 
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124 

1250 

1240 " DEFINITION DES VARIABLES 

1250 ! Z2==2====================-= 

1260 

1270 ! CRET Table (6,2) des COEFFICIENTS de RETENUES 

1280 TYRET$ Table (6) des TYPES de RETENUES 

1290 BRET TABLE (6) des BASES de RETENUES 

1500 RET TABLE (6) des RETENUES 

1310 R6 Total RETENUES 

1520 x Difference SALAIRE-PLAFOND SS 

1350 ‘ Z PLAFOND ou SALAIRE si SALAIRE <PLAFOND 

1340 BASE Table (6,2) des TOTAUX BASES 

1350 MRET Table (6,2) des Montants RETENUES 

1360 " TENUE Table (2) des totaux RETENUES par CATEGORIE 
1370 ! TIMPO Table (2) des totaux IMPOSABLES par CATEGORIE 
1380 TTRAN Table (2) des totaux TRANSPORTS par CATEGORIE 
1390 TNET Table (2) des totaux SALAIRES NET par CATEGORIE 
1400 ‘ TREPAS Table (2) des totaux REPAS par CATEGORIE 
1410 ‘ TSALA Table (2) des totaux par CATEGORIE 

1420 

1450 ‘ 

1440 

1450 Coefficients retenues Bases retenues Retenues 
1460 ! CRET(,) BRET() RET() 
2470 "2 
1480 1.035 ! .035 ! ! ! ! ! 
1496 1.010 ! .035 ! ! ! ! ! 
1500 1.047 1 .047 ! X ! ! = ! ! 
1510 ‘ ! .0084 ! .0084! ! ! ! ! 
1520 ! .0618 ! .0 ! ! ! ! ! 
1530 ‘ 1 .0245 ! .0245! ! ! ! ! 
2540 1 
1590: * 

1560 Cadres Employes 

2970 
1580 " 

1590 ‘ TOTAUX 

1600 

1610 Totaux base Montants retenues 

1620 BASE, ) MRET(,) 

16350 1 

1640 ' 1! ! ! ! ! ! 

1656 ! ! ! ! ! ! 

1660 ! ! ! ! ! ! 

1670 ! ! ! ! 

1680 ! ! ! ! 

1690 ' 6 ! ! ! ! 

1700 1 
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25.12.80 Nicole LANGEARD Secretaire EMPLOYE 


Salaire Brut 8200.00 


Base Retenues 


S.S. MAL. S/SAL. TOTAL .0350 8200.00 287.00 

S.S. MAL. S/SAL PLAF .0100 5600.00 50. 00 

S.S. VIEL S/SAL PLAF .-0470 5000.00 235.00 

Assurance chomage -0084 8200.00 68.88 

Retraite des cadres .0000 3200.00 0.00 

Retraite complementaire .-0245 5000.00 122.50 
Total des Retenues 763.38 
Salaire NET IMPOSABLE 7436.62 
Salaire a payer 7536.62 
TOTAUX EMPLOYE Nombrez= 3 
Salaires de base 24000. 00 
Indeminites de REPAS 600.00 
Salaires brut 24600. 00 


Base des retenues Retenues 


S.S. MAL. S/SAL. TOTAL 24600.00 861.00 
S.S. MAL. S/SAL PLAF 15000.00 156.00 
S.S. VIEL S/SAL PLAF 15000.00 705.00 
Assurance chomage 24600.06 206.64 
Retraite des cadres 9600. 00 0.00 
Retraite complementaire 15000.00 367.50 
Total Retenues 2290.14 
Salaires NET IMPOSABLE 22309.90 
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EDITION AUTOMATIQUE DE TABLEAUX 


Ce programme permet d'éditer automatiquement sur plusieurs 
colonnes et sur plusieurs pages, deux tables à une dimension 
qui peuvent représenter par exemple un index de livre. 


Sur l'exemple, les mots-clés et les numéros de pages sont 
fournis dans des DATA et lus dans deux tables CLES() et PAGES(). 
Ils pourraient tout aussi bien être extraits de fichiers à accès 
direct ou séquentiel. 


Le principe consiste à imprimer sur une même ligne plusieurs 
éléments séparés par un écart égal au nombre de lignes par page. 


AUtO Lise 23 Files........ 23 Merge........ 23 
Clear........ 23 Killssssessée 23 Name......... 23 
Commandes .... 23 List......... 23 New.......... 23 
Delete....... 23 Llist........ 23 Renum........ 23 
Editeur...... 21 Load......... 23 RUN... 23 
Fe INTER | 

Save......... 23 TrOÉP esse 23 VARIABLES.... 25 
System....... 23 TrONs ss sos 23 


NCoL=3 
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30 

40 

50 

60 

70 

80 

90 

100 
110 
120 
130 
140 
150 
160 
170 
180 
190 
200 
210 
220 
230 
240 
250 
260 
270 
280 


290 
310 
330 
340 
350 
360 
370 
380 
390 
400 
410 
420 
450 
460 
470 
480 
490 
500 
510 
520 
530 
540 
550 
560 
)); 
570 
580 
590 
600 
610 
620 
630 
640 
650 


LE BASIC ET SES FICHIERS 


* EDITA EDITION AUTOMATIQUE DE TABLEAU 
, 

LU 

: (index de livre) 

CLEAR(5000) 

NB=20 " Nombre d'elements 

DIM CLES$(NB) ,PAGES$ (NB) 


DATA Commandes ,23 
DATA Auto,23,Clear,23,Delete,23,Files,23 


DATA Ki11,23,List,23,Ll1ist,23,Load,23,Name,23,New,23 


DATA Merge,23,Renum,23,Run,23,Save,23,System,23,Tron,23 


DATA Troff,23 
DATA Editeur ,21 
DATA VARIABLES ,25 


' LECTURE DES DATAS dans CLE$() et PAGE$() 


FOR I=1 TO NB 
READ CLE$(I) 
READ PAGE$(I) 


K=NB " TRI des TABLES 
INV=0 


FOR I=1 TO K-1 
IF CLE$(I+1)<CLE$(I) THEN 


SWAP CLES$(I),CLE$(I+1):SWAP PAGE$(I) ,PAGE$(I+1):INV=1 


NEXT I 


, EDITION SUR 3 COLONNES 


LPRINT 
1! 


NLIGNE=6 
NELEM=5 
NCOL=3 
INTER=30 
MARGE=15 
' 


Nombre de colonnes 


FOR PGE=1 TO 1000 
IF NB<NELEM#NCOL#(PGE-1) THEN STOP 
ECART=INT((NB-(NELEM#NCOL)#(PGE-1)+NCOL-1)/NCOL) 
IF NB>NELEM#NCOL#PGE THEN ECART=NELEM 
! 
FOR LGNE=1 TO ECART 
X=LGNE+(PGE-1)#NELEM#NCOL 
FOR L=1 TO NCOL 
LPRINT TAB(INTER#(L-1)); 
IF X+ECART#(L-1)>NB THEN STOP 


Nombre de lignes par page 
Nombre de lignes a imprimer par page 


Intervalle entre 2 colonnes 
Marge entre mot-cle et no de page 


1000 pages 


Page incomplete 
Page complete 


Edition d'une page 
X:element premiere colonne 
Edition d'une ligne 


LPRINT CLE$(X+ECART#(L-1)) ; STRING$("." ,MARGE-2-LEN(CLES$(X+ECART#(L-1)) 


LPRINT TAB(MARGE+INTER#(L-1)); 
LPRINT PAGE$(X+ECART#(L-1)); 
NEXT L 
LPRINT 
NEXT LGNE 
' 
FOR K=NELEM TO NLIGNE:LPRINT:NEXT K 
FOR K=2 TO 200:NEXT K 
NEXT PGE 
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EDITION D'ETIQUETTES 


Ce programme permet d'éditer des étiquettes d'adresses 
stockées dans un fichier Random. 


Différentes variables définissent : 


- le nombre d'étiquettes par ligne 
- l'intervalle entre chaque étiquette 


L'édition de plusieurs étiquettes sur la même ligne nous 
oblige à stocker les noms et adresses dans des tables avant 
de les imprimer. 


NUMSC) RUES () VILLES) CPUSTS() 
ROULE] |14,Ruc..…. | PARIS |  fouuc | 
MARTIN | | | j 


ou 4 


RUULET RE  akTin _ | 
L 14,Rue de MILAN | 12,Rue de PARIS 


YZ1UG BUULUGN GN | 
sverl_ 70 BUULUGNE En | 921UL BUULUGNE _ 
REE Ne | — É) mate | 

F1DON [| LUCET | 
| 45,Kue de la BIENFAISANCE | | 67,Rue du CHIEN QUI FUME | 
| 220 SEVRES 922CU SEVRES 


RRN 1 


BESSE 


5,Rue la BRUYERE 
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30 ‘ ETIQ 3.11.80 EDITION D'ETIQUETTES 
50 ! 
60 ! 
110 ! 
210 ! 
220 ‘ 
230 
240 OPEN "R",1,"ETIQ" 
250 FIELD #1,15 AS NOM$,25 AS RUE$,15 AS VILLE$,6 AS CPOST$ 
260 ! 
270 INPUT "Mode? (CR,ETIQ,..) ";M$ 
280 IF M$="CR" THEN GOSUB 330 
290 IF M$="ETIQ" THEN GOSUB 460 
300 GOTO 270 

U 


Si le saut de page n'est pas necessaire supprimer la ligne 630 


310 “commen —mmmmmmnm mm 
320 CREATION 
330 NR=LOF(1) " Rangement en fin de fichier 


340 GET #1,NE 
350 INPUT "Nom? ";X$:IF X$<>"" THEN LSET NOM$=X$ 

360 IF X$="" THEN RETURN 

370 LINE INPUT "Rue? ";X$:1IF X$<>"" THEN LSET RUES$=X$ 

380 INPUT "Ville? ";X$:1IF X$<>"" THEN LSET VILLE$=X$ 

390 INPUT "Cpost? ";X$:IF X$C@"" THEN LSET CPOST$=X$ 

4OO PUT #1,NR 

410 PRINT'RANGE EN:";NR 

420 GOTO 330 

430 '=====2=2=22==2==22=2222=22=2222=222222==5==222222=22=22=2222=22222222255 
y4O ! SORTIE ETIQUETTES 

450 ‘ 

460 NE=2 

470 IHORIZ=35 


Nombre etiquettes par ligne 

Intervalle horizontal 

480 IVERT=8 Intervalle vertical 

490 NLPAGE=71 Nombre de lignes par page 

500 MARGE=2 " Marge de debut 

510 ! 

520 NRANG=INT((NLP)/IVERT) " Nombre de rangees par page 
530 SP=NLPAGE-NRANG*#IVERT " Saut de page 

540 ! 

550 N=0:TRANG=0 

560 ! 

570 FOR I=1 TO LOF(1) " Lecture de tout le fichier 

580 GET #1,1 

590 IF ASC(NOM$)=0 THEN 640 ‘ Enregistrement vide? 

600 N=N+1 

610 NOM$(N)=NOM$ : RUES$(N)=RUE$ : CPOST$(N)=CPOSTS$ : VILLE$(N)=VILLE$ 
620 IF N=NE THEN GOSUB 700:TRANG=TRANG+1: N=0 


630 IF TRANG=NRANG THEN FOR K=1 TO SP:LPRINT:NEXT K:TRANG=0 ! Saut de page 
640 NEXT I 

650 IF N>=1 THEN GOSUB 700 

660 RETURN 

670 

680 ! SPGM Edition etiquettes 

690 ! 


700 FOR K=1 TO N:LPRINT TAB(MARGE+(K-1)#IHORIZ) ;NOM$(K); :NEXT K:LPRINT:LPRINT 

710 FOR K=1 TO N:LPRINT TAB(MARGE+3+(K-1)#IHORIZ) ; RUE$(K) ; :NEXT K:LPRINT 

720 FOR K=1 TO N:LPRINT TAB(MARGE+3+(K-1)#IHORIZ) ; CPOST$; VILLES; :NEXT K:LPRINT 

730 ‘ 

740 FOR K=1 TO IVERT-U :LPRINT:NEXT K ‘ Intervalle vertical (4=nb lignes impri 
mees avant) 

750 RETURN 
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INITIATION AU TRAITEMENT DE TEXTE 


Le traitement de texte en Basic peut être fait en lisant un 
fichier texte, caractère par caractère, (à l'aide de INPUTS#), 
mais en Basic interprété, le temps d'analyse de chaque caractère 
est relativement long. 


L'utilisation de la fonction INSTR (début, chaîne à analyser, 
chaîne cherchée), plus rapide et plus pratique, présente cepen- 
dant la restriction suivante : 


11 faut prendre soin, si par exemple on recherche la première 
chaîne 'FOR' placée entre guillemets dans une ligne "BASIC, de 
limiter le domaine de recherche de "FOR' en ayant auparavant 
recherché les positions des deux premiers guillemets. ‘ 


---" FOR "------- L=————- FOR ------ 
On recherche le FOR entre guillemets. 


Dans ce programme de décalages de boucles FOR-NEXT il s'agit, 
à chaque fois qu'un FOR est rencontré, d'augmenter la marge 
d'impression de trois par exemple. Au contraire, pour chaque 
NEXT rencontré, on diminue la marge de trois. 


Si les FOR-NEXT ne sont pas appaires, (ils doivent l'être 
avec les Basics compilés), nous nous recadrons sur la première 
boucle '"FOR' externe. Naturellement, les FOR, NEXT, REM entre 
guillemets ne doivent pas être pris en considération. 


Notons au passage que si les Basics interprétés acceptent 
les FOR-NEXT non appaires, il est vivement conseillé, pour des 
raisons de lisibilité, de ne pas utiliser cette facilité. Le 
nom de variable doit aussi de préférence être noté après NEXT, 
non seulement pour la lisibilité mais pour éviter qu'un programme 
se poursuive en incrémentant une autre variable que celle qui 
a été implicitement prévue par le programmeur. 


Détails du programme : 


- On lit le programme Basic ligne par ligne 

- La partie programme de chaque ligne est séparée des commen- 
taires (recherche de " et REM) 

- On recherche ensuite les FOR et NEXT 
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10 ' DFOR 30.10.80 

20 ! 

30 PROGRAMME DE DECALAGE DE BOUCLES 'FOR' 

40 ! 

50 Ce programme permet d'editer un programme en cadrant les boucles FOR 
60 ! et les commentaires. 

70 ‘ Le programme traite doit etre sauvegarde sous forme ASCII(i.e.non 

30 ! preinterpretee ) par ' SAVE "XXX",A ! 

30 ! 

100 

110 ! CADRAGE des COMMENTAIRES en COLONNE 60 

120 ! 

130 VERSIONS MICROSOFT AVEC ESPACES SEPARATEURS(A ADAPTER POUR TRS80)_ 
140 ! 

150 ! LIGNE$ : Ligne lue dans le fichier 

160 LTRAIT$ : Ligne sans les commentaires ( ‘ ou :REM) 

170 ! 

180 MARGE=5 

190 LIGNES$="" 

200 INPUT "NOM DU PROGRAMME? ";PGM$ " Sauvegarde en ASCII 

210 OPEN "I",#1,PGM$ 

220 ! 

230 IF EOF(1)=-1 THEN STOP ‘ Fin de fichier 

240 INPUT #1,NUML " No de ligne 

250 LPRINT NUML; 

260 
270 separation pgm et com 

280 ! 

290 —---" : M M! a 1 XXXXXX Analyse commentaire 
300 ‘! ! ! ! 

310 ! pi pe p2 

320 CC=50 " Cadrage commentaire 

330 

340 LINE INPUT #1,LIGNE$:LIGNE$=" "4LIGNE$ ‘ Lecture d'un enregistrement 
350 

360 PE=0:P1=0 

370 " 


380 P1=INSTR(PE+1,LIGNES$,CHR$(34)):IF P1<>0 THEN P2=INSTR(P1+1,LIGNE$,CHR$(34)) ELS, 
E P2=0 


390 

400 P(1)=INSTR(PE+1,LIGNES$,"'"): 

410 P(2)=INSTR(PE+1,LIGNES$," REM") " NREM" sur TRS80 
420 P(3)=INSTR(PE+1,LIGNES$,":REM") 

430 ! 

44O PE=255 

450 FOR I=1 TO 3 " Recherche du plus petit 

460 IF P(I)<>0O THEN IF P(I)<PE THEN PE=P(I):RP=I 
470 NEXT I 

y80 ! 

490 IF PE=255 THEN PE=0 

500 ! 


510 IF PE<>0 THEN IF PE>P1 AND PE<P2 THEN PE=P2:GO0OTO 380 

520 IF PE<>0 THEN LTRAIT$=LEFTS$(LIGNES,PE-1):COM$=RIGHT$(LIGNES$, LEN (LIGNE$)-PE+1) E 
LSE LTRAIT$=LIGNES$:COM$="" 

521 ! 

522 ‘ 
523 ‘ 
524 ! 
525 ‘ 
526 ! 
527 ' 
530 ‘ 
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531 
532 
533 
534 
538 
540 
550 
560 
570 
580 
590 
600 
ote 
610 
620 
630 
640 
650 


LE BASIC ET SES FICHIERS 


| 
L 
' 
: 
L 
Ÿ Recherche FOR et NEXT 
1’ 
' 
LU 
! 
LU 
L 


—-" FOR EU] FOR "---—— FOR I=1 TO 10 Analyse d'une ligne 
! ! ! 
P1 pe pe 


FC : Limite de la chaine a analyser P1 : Premiere quote P2 : Deuxieme qu 


' FR : Presence de FOR dans la ligne NX : Presence de NEXT 
LU 


PE=0:PE=0:FR=0:NX=0 : AMARGE =MARGE 


P1=INSTR(PE+1,LTRAITS,CHR$(34)):IF P1<>0 THEN P2=INSTR(P1+1,LTRAIT$,CHR$(34)): 


ELSE P2=0 


660 
670 
680 
690 
700 


FC=P2:1F FC=0 THEN FC=255 

Li 

X$=LEFT$(LTRAITS$,FC) 

P(1)=INSTR(PE+1,X$," FOR ") " "FOR" sur TRS80 

P(2)=INSTR(PE+1,X$,":FOR") 

P(3)=INSTR(PE+1,X$," NEXT ") * "NEXT" sur TRS80 

P(4Y)=INSTR(PE+1,X$,":NEXT ") 

PE=255 

FOR I=1 TO 4 ‘ Recherche du plus pres 
IF P(I)<>0 THEN IF P(I)<PE THEN PE=P(I):RP=I 

NEXT I 

LU 


IF PE=255 THEN PE=0 
' 
IF PE@O THEN IF RP<3 THEN IF PE>P1 AND PE<P2 THEN PE=P2 ELSE MARGE=MARGE+3::FR 


IF PE©O THEN IF RP>2 THEN IF PE>P1 AND PE<P2 THEN PE=P2 ELSE GOSUB 970:NX=1 
IF PE@O THEN GOTO 650 

IF FC<255 THEN PE=P2:GOTO0 650 

1! 


IF FR=1 THEN LPRINT TAB(AMARGE); LTRAIT$;TAB(CC) ;COM$:GOTO 230 


860 IF NX=1 THEN LPRINT TAB(MARGE );LTRAITS$;TAB(CC) ;,COM$:GOTO 230 

870 

880 ‘ 

890 IF LTRAIT$="" THEN LPRINT ;COM$:GOTO 230 " Ligne commentaire 

900 IF LTRAIT$=" " THEN LPRINT " ";COM$:GOTO 230 ©‘ Ligne commentaire 

910 ! 

920 IF LTRAIT$<>" " THEN LPRINT TAB(MARGE);LTRAITS$;TAB(CC) ;COM$:GOTO 230 

930 ‘ 

CITES RER RER RER EEE EE EEE RENE RE 

950 ! Traitement de NEXT ou NEXT I,J,K 

960 ! 

970 IF MARGE>5 THEN MARGE=MARGE-3 ELSE PRINT "FOR-NEXT PAS APPAIRES EN :";NUML 
980 PP=INSTR(PE+1,LTRAITS$,":"):IF PP=0 THEN LNEXT$-LTRAIT$ ELSE LNEXTS$=LEFTS$(LTRAIT 
$,PP) 

990 PV=PE 


1000 PV=INSTR(PV+1,LNEXT$,","):IF PV=0 THEN 1020 ELSE IF MARGE>5 THEN MARGE =MARGE-3 
:GOTO 1000 ELSE PRINT "FOR-NEXT PAS APPAIRES EN:";NUML:GOTO 1000 


1010 


1020 RETURN 
1030 
1060 
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10 ! 
20 ! 


LE BASIC ET SES 


ESSAI DE DECALAGES DE BOUCLES 


30 FOR I=1 TO 10 ‘ POUR I=1 TO 10 
4O PRINT I; 


50 NEXT I " Iz=l+1 
Li 


70 FOR I=1 TO 5 

80 FOR J=1 TO 10 

90 PRINT "I=";I;"J=";9 

95 PRINT " FOR: ";" NEXT "; 
NEXT J 

NEXT I 


130 FOR I=1 TO 5:FOR J=1 TO 3 


170 FOR P=1 TO 5 


210 FOR I=1 TO 5 


PRINT "FOR " 
NEXT I,J 


IF P=3 THEN NEXT P 
NEXT P 
LU 


"FOR" 


PA 


" FOR-NEXT non appaires. 


ESSAI DE DECALAGES DE BOUCLES ‘'FOR' 


FOR I=1 TO 10 
PRINT I; 
NEXT I 


FOR I=1 TO 5 
FOR J=1 TO 10 
PRINT "I=";1;"J=";9J 
PRINT " FOR: ";" NEXT "; 
NEXT J 
NEXT I 
( 


FOR I=1 TO 5:FOR J=1 TO 3 
PRINT "FOR " 

NEXT I,J 

U 


FOR P=1 TO 5 
IF P=3 THEN NEXT P 
NEXT P 
' 
FOR I=1 TO 5 
PRINT I 
NEXT I 


" Recadrage sur boucle externe 


FICHIERS 


ca 


" Essai avec NEXT I,J 


" POUR I=1 TO 10 


" I=l+1 


LA 
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" Essai avec NEXT 1I,J 


" FOR-NEXT non appaires. 


" Recadrage sur boucle externe 


LE BASIC ET SES FICHIERS 


LISTES INVERSES 


Les systèmes de fichiers actuels ne permettent pas d'accéder 
aux enregistrements par leur contenu (mémoires associatives). 
Par exemple, il faut lorsque l'on recherche dans un fichier 
toutes les pièces d'un casier de rangement, explorer le fichier 
des stocks dans sa totalité en ne sélectant que les enregistre- 
ments correspondant au casier concerné. 


Ceci peut devenir long pour des fichiers de taille importante. 
Aussi est-on amené à créer une liste inverse donnant pour chaque 
casier, la liste de tous les enregistrements qui lui sont rela- 
tifs. 


Les listes inverses sont mises à jour en ‘temps réel' à chaque 
ajout dans le fichier principal. Il est cependant prévu de les 
recréer en différé en cas d'incident. 


Table CUDE$ Table 1X% Fichier liste Fichier principal 
cs fe 4 lue | É0000ex | 
=> [1 2 VIS 
3 3 . 
RANGÿ PT$() REF y () CRANG$() 
No casier de 
rangement 


Exemple d'exécution : 


Quel casier? B6 


CLE 
CLOU 


Si les mots-clés sont déterminés et fixés, une organisation 
plus économique est possible. Sur cet exemple, une simple bit- 
map permet de coder pour chaque personne, les différentes langues 
parlées. 


FICHIER LISTES INVERSES Ficmier PRINCIPAL 


89 


LE BASIC ET SES FICHIERS 


LINVS 8.1.81 


LISTE INVERSEE 


REFS$ : REFERENCE 
CRANG$ : CASIER RANGEMENT 
RANGS : CASIER RANGEMENT 


#1 
#1 
12 


CODES : TABLE DES CODES (CASIERS) 
IXX : INDEX VERS LE FICHIER INDEX (#2) 
PTS : POINTEURS VERS LE FICHIER PRINCIPAL 


DIM PT$(110),CODES(50),IX%(50) 
OPEN "R",L1,"LINVS" 


" Fichier principal 


FIELD #1,12 AS REFS$,30 AS LIBS,4 AS PACHAS,4 AS PVENTES, 
4 AS QVS,4 AS STKS$S,5 AS CRANGS 


OPEN “R",#2,"ILINVS" 


GOSUB 920:GOSUB 680 


" Fichier listes inverses 
FOR 1=1 TO 110:FIELD #2,5 AS RANGS,(I-1)*2 AS D$,2 AS PTS(I):NEXT I 
" APPEL CONSTITUTION CLES(),1IX%() 


CLS:PRINT TAB(10) "PROGRAMME DE LISTE INVERSE":PRINT " MENU 


PRINT TAB(10) “MODES :":PRINT 
PRINT IAB(20) "“C :CREATION" 


PRINT TAB(20) "CRI :CREATION INDEX" 
PRINT TAB(20) "LISTE :LISTE PAR CASIER" 
PRINT::INPUT “MODE (C,LISTE,CRI,RCAS ";MODES 


IF MODES="C" THEN GOSUB 290 


IF MODES="CRI" THEN GOSUB 380:GOSUB 680 


IF MODE$="LISTE" THEN GOSUB 760 
IF MODE$="RCAS" THEN GOSUB 1020 
GOTO 220 


fRR====22===222=2=2222===222=2222-2==2==22=22===22=22====2=2===22===222== 


NE=LOF(1)+1:GET #1,NE 


" CREATION (C) 


X$="":INPUT "REFERENCE ";XS:IF X$="" THEN RETURN 


Y$="": INPUT "RANGEMENT ";Y$ 
LSET REF$=XS:LSET CRANGS=YS 
PUT #1,NE 
GOSUB 480 
GOTO 290 


" APPEL MAJ LISTE INVERSE 


CREATION LISTE INVERSE(CRI) 


CLOSE #2:KILL “ILINVS":OPEN "R",#2,"ILINVS" 
FOR I=1 TO 50:CODES$(I)="":NEXT L:NB=0 " NB:NOMBRE DE CLES 


FOR NE=1 TO LOF(1) 


GET#1,NE:IF ASC(REFS)=0 GOTO 440 


PRINT REF$,CRANGS 
GOSUB 480 
NEXT NE 
CLOSE #2:OPEN "R",#2,"ILINVS" 


FOR K=1 TO 50 


IF CRANG$=CODES(K) GOTO 540 


IF CODE$(K)="" THEN CODES(K)=CRANGS : IX%(K)=K:NB=NB+1:GOTO 540 


NEXT K 
STOP 


GET #2,IX%(K) 
FOR I=1 TO 110 


MAJ LISTE INVERSE 


" LE CODE EXISTE DEJA 


IF CVI(PTS(I))=0 TilEN LSET PT$S(I)=MKIS(NE): 
LSET RANGS=CODES$(K):PUT #2,K:GOTO 590 


NEXT I 
STOP 
RETURN 


fmm===22=222222=2=22222==2222==222===22==2222==2222222222=2222=22222= 
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619 
620 
630 
0490 
650 
660 
670 
630 
690 
700 


719 
720 
730 
740 
750 
760 
779 
780 
790 
800 
819 
320 
330 
840 
850 
360 
879 
880 
890 
900 
910 
920 
930 
940 
950 
960 
970 
980 
990 
1000 
1010 
1020 
1030 
1040 
1050 
1060 
1070 
1080 
1090 
1190 
1110 
1120 
1130 
1140 
1150 


LE BASIC ET SES FICHIERS 


FOR I=1 TO NB-1 * TRI DE CLES() ET IXZ() 
FOR J=[+1 TO NB 
IF CODES(J)<CODES(I) T!IEN 
XS=CODES(J):CODES$S(J)=CODES(1):CODES(I)=X$: 
X=1X4(1):1IX2(1)=IX2(J):IX2(J)=X 
HEXT J 
NEXT I 
RETURN 
fmm22222222222222222=2222222=2222=222=22222222222222222L22S2=SS=SSS=S 
: LISTE PAR CASIER(LISTE) 
PRINT :PRINT “CASIER" TAB(20) "REFERENCE": PRINT 
FOR CODE=L TO LOF(2) 
GET #2,IX4(CODE) 
[F ASC(RANGS)=0 GOTO 880 
PRINT RANGS; 
' 
FOR I=1 TO 55 
NE=CVI(PTS(I)):IF NE=0 GOTO 870 
GET #1,NE:PRINT TAB(20) REFS 


NEXT L 
: 
PRINT 

NEXT CODE 
RETURN 
lmm=22222=2=2=22=22222=2222222=2222222=2222222=22222====222===2222222= 
' CONSTITUTION DES TABLES CODES ET IX4 
N3=0 * NB:NOMBRE DE CLÉS 
FOR I=1 TO LOF(2) 

GET #2,1 


IF ASC(RANGS)=0 THEN GOTO 980 
PRINT RANGS, I 
NB=NB+1 : CODES (NB)=RANGS : IX2(NB)=I 
WNEXT I 
RETURN 
lmR2=222222=222222222222222222222222222222222222222D2S=SAUSSSSZZS 
, INTÉRROGATION PAR CASIER(RCAS) 
PRINT:X$="":INPUT "CASI£R CHERCIHE ";XS:IF X$="" THEN RETURN 
FOR I=1 TO NB 
IF XS=LEFTS(CODES(I),LEN(XS)) THEN GOTO 1090 
NEXT I 
' 


PRINT "CE CASIER N'EXISTE PAS":PRINT:GOTO 1020 
! 


GET #2,1X4(L):PRINT 

FOR K=1 TO 55 
NE=CVI(PIS(K)):IF NE=0 GOTO 1140 
GET #1,NE 
PRINT REFS 

NEXT K 

GOTO 1020 
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ANALYSE D'UN FICHIER SELON DEUX CRITERES 


Nous analysons, dans un fichier d'adresses, la répartition 
des professions par département. Pour cela, nous remplissons 
une table à deux dimensions CUMUL%(,). 


Afin d'éditer les résultats dans l'ordre croissant des 
départements et des professions, nous utilisons deux couples 
de tables DEPARTS-XD% et PROFS-XP% qui seront triées avant 
l'édition de CUMUL% (voir dessin). 


Pour chaque enregistrement lu dans le fichier, nous recherchons 
si le département et la profession existe déjà dans DEPARTS() 
et PROFS(). S'ils n'existent pas, nous les ajoutons en fin de 


table. 
Derws0 Ces Tzz [#8] 
xMO(Cz T1731] 
PROFS O  xPX() + | 


FCHIER ANALYS € 


TABLE CumuL®/ (5) 
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10 ' ANA 12.10.80 

20 ! 

30 ANALYSE D'UN FICHIER SELON 2 CRITERES 
10 sassessssesessssssesesssszssss2s2z2223 
50 ! 

60 DP : departement 

70: PF : profession 

80 ! NPROF : nombre de professions 

90 NDEP : nombre de departements 

100 ! 

110 CLEAR(2000) 

120 MDEP=20 * Nombre de departements maxi 
130 MPROF=20 " Nombre de profession max 
140 

150 DIM DEPARTS$(MDEP) , PROF $ (MDEP) 

160 ! 

170 NDEP=0 : NPROF =0 

180 ! 


190 OPEN "R",#1,"ANA" 

200 FIELD #1,12 AS NOM$,10 AS DEPART$,10 AS PROF$ 

210 ! 

220 INPUT "MODE? ";M$ 

230 IF M$="CR" THEN GOSUB 270 

240 IF M$="LIST" THEN GOSUB 370 

250 GOTO 220 

260 1" CREATION 
270 ARANG=LOF (1) " LOF(1)+1 sur TRS80 

280 GET #1,ARANG 

290 INPUT "NOM? ";X$:IF X$="" THEN RETURN ELSE LSET NOM$=X$ 
300 INPUT "DEPARTEMENT ? ";X$:LSET DEPART$=X$ 

310 INPUT "PROFESSION? ";X$:LSET PROF$=X$ 

320 PUT #1,ARANG 

330 PRINT:PRINT"RANGE EN:";ARANG 

340 GOTO 270 

350 1" 
360 ‘ LECTURE DU FICHIER 
370 FOR NE=1 TO LOF(1) 

380 GET #1,NE:IF ASC(NOM$)=0 THEN 530 

390 PRINT NOM$,DEPARTS$, PROF$ 


400 ! 

410 FOR DP=1 TO MDEP " Recherche departement 
420 IF DEPART$=DEPART$(DP) THEN GOTO 460 

430 IF DEPART$(DP)="" THEN 


DEPART$(DP)=DEPARTS$:XD#(DP)=DP:NDEP=NDEP+1:GOTO 460 
44O  NEXT DP 


450 ! 

460 FOR PF=1 TO MPROF " Recherche profession 
470 IF PROF$=PROF$(PF) THEN GOTO 510 

480 IF PROF$(PF)="" THEN 


PROF$(PF)=PROF$:XP#(PF)=PF:NPROF=NPROF+1:GOTO 510 
190 NEXT PF 
500 
510 CUMUL#(DP,PF)=CUMUL#4(DP ,PF)+1 
520 ‘ 
530 NEXT NE 
540 ! 


542 ! 


550 1 
551 ! 
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559 ! 
560 TRI DES DEPARTEMENTS (bubble) 
570 FOR I=1 TO NDEP-1 
580 FOR J=I+1 TO NDEP 
590 IF DEPART$(J)<DEPART$(I) THEN 
SWAP DEPART$(I) ,DEPART$(J):SWAP XD#(I) ,XD#(J) 

600 NEXT J 
610 NEXT I 
620 1 
630 ! TRI DES PROFESSIONS (bubble) 
640 FOR I=1 TO NPROF-1 
650 FOR J=I+1 TO NPROF 
660 IF PROF$(J)<PROF$(I) THEN 

SWAP PROF$(I) ,PROF$(J):SWAP XP#(I),XP#4(J) 
670 NEXT J 
680 NEXT I 
690 '======2=2=222==2=2===2222=2222222222222222=222=2222222222222222222=22222222 
700 EDITION DES RESULTATS 
710 LPRINT:LPRINT 
720 FOR L=1 TO 5 * Edition des departements (en vertical) 
730 LPRINT TAB(10+4); 
740 FOR DP=1 TO NDEP 
750 X$=MID$(DEPARTS$(DP),L,1):LPRINT X$;SPC(4); 
760 NEXT DP 
770 LPRINT 
780 NEXT L 
7 
800 FOR PF=1 TO NPROF " Edition de la table CUMUL# 
810 LPRINT PROF$(PF);TAB(10) 
820 TPROF =0 
830 FOR DP=1 TO NDEP 
840 X=CUMULZ(XD#(DP) ,XP#4(PF)) 
850 IF X><O THEN LPRINT USING "####H#"3;X; ELSE LPRINT " ae 
860 TPROF=TPROF+X 
870 TTAL(DP)=TTAL(DP)+X 
880 NEXT DP 
890 LPRINT USING "###Hf#f"; TPROF 
900 NEXT PF 
DO 
920 LPRINT:LPRINT TAB(10); 
930 FOR DP=1 TO NDEP 
940 LPRINT USING "#4##ff"; TTAL(DP); 
950 NEXT DP 
960 RETURN 

7 7 7 9 

5 vi 8 2 
BARMAN . 1 ë : 1 
ENSEIGNANT “ ï 1 $ 1 
EPICIER 2 6 . . 2 
PLOMBIER e . . 1 1 
POMPISTE 1 ë , . 1 

3 1 1 1 
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INTERROGATION DE FICHIER 


Plutôt que d'écrire des programmes d'interrogation de fichier 
pour chaque type de demande, il est intéressant de disposer d'un 
langage d'interrogation général simple à utiliser. 


Nous allons d'abord traiter un cas simple de recherche multi- 
critères du type : 


‘Quels sont tous les plombiers de paris gagnant plus de 7000F' 
L'opérateur formulera sa question sous la forme suivante : 
PROF=PLOMBIERXVILLE=PARISXSALAIRE)7000 


Il nous faut définir les noms des zones du fichier. Nous le 
faisons par une table NZ$() contenant NOM, PR, PROF, VILLE, SALAIRE 


Une fois l'interrogation formulée par l'opérateur, nous l'a- 
nalysons pour constituer une table CRITS() contenant les critères 
recherchés : PLOMBIER, PARIS et 37000 dans l'exemple choisi. Après 
avoir constitué cette table, nous documentons, pour chaque enre- 
gistrement lu dans le fichier, une table de vérité TV() avec 1 
si le critère est vérifié ou 0 si le critère n'est pas vérifié. 
Ensuite, nous effectuons un 'ET' logique sur cette table de 
vérité. 

Si le résultat est égal à 1, nous sélectons l'enregistrement 
lu. Pour un fichier de taille importante, la sélection devient 
longue. Aussi est-on amené, pour des fichiers importants, à 
définir au moment de la création des enregistrements des couples 
mots-clés, pointeurs permettant de retrouver directement les 
enregistrements concernés par l'interrogation. 


Pour une recherche plus élaborée qu'un simple "ET logique" 
comme ci-dessus, nous pouvons formuler une interrogation de la 
façon suivante : 


(PROF=PLOMBIER+PROF-=EPICIER) XVILLE=PARIS 


I1 nous faut alors évaluer l'expression par une méthode que 
nous verrons plus loin. 
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INTF 31.10.80 
INTERROGATION DE FICHIER 
Ce programme permet de SELECTER les enregistrements repondant a un ou 
plusieurs criteres, e.g. "Quels sont tous les PLOMBIERS de PARIS gagnant 
plus de 7000f 


PROF=PLOMBIER#*VILLE=PARIS#SALAIRE>7000 


Fichier 'NOM' 


U 
! 
! 
" ZN$(1) 
! 
U 
u 
! 


NZ=5 

DATA NOM,PR, VILLE, PROF , SALAIRE 

FOR I=1 TO NZ:READ NZ$(I):NEXT I " Table des noms de zone 
LU 


DATA 15,12,20,15,4 
FOR I=1 TO NZ:READ LZ(I):NEXT I " Table des longueurs des zones fichier 
LU 


DATA 1,1,1,1,2:FOR I=1 TO NZ:READ TZ(I):NEXT I ' Type de zone 1 ou 2 
1! 


OPEN "R",#1,"INTF" 
S=0:FOR 1=1 TO NZ:FIELD #1,S AS D$,LZ(I) AS ZN$(I):S=S+LZ(I):NEXT I 
L 


PRINT:INPUT "Mode? (CR,ET,...) ";M$ 
IF M$="CR" THEN GOSUB 400 
IF M$="ET" THEN GOSUB 630 


GOTO 340 

épis etseséodiess ssl ler smiémeteliimisesedodemasaticrae saisis 
# CREATION D'ENREGISTREMENTS 

PRINT 

NE=LOF(1) " Ajout en fin de fichier (LOF(1)+1 sur TRS80) 

GET #1,NE 


FOR I=1 TO NZ 

PRINT NZ$(I);TAB(20);:INPUT X$ 

IF TZ(1)=1 THEN LSET ZN$(I)=X$ ELSE LSET ZN$(I)=MKS$(VAL(X$)) 
NEXT I 


PUT #1,NE 

PRINT: PRINT "Range en:";NE 

RETURN 
l2zzz=2222222222222222=2222222222222222S22SSSSSSSSSSSSSSSSSSS=S===SSSSEE 
' INTERROGATION par 'ET' 
' 

" NZ$  OPES$ CRIT$ TV 

' sale RS ms EEE ER ax 
"ENOM! IXXX! IXXXXX!  ! 

"OIPR OO! OIXXX! IXXXXX! ! 

" VILLI =! (VERSA! 11! 
"APROFI ! = ! IPLOMB!  !O! 

" JSALA! ! > ! 15000 ! 11! 

! 

! 
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620 ! 

630 PRINT:FOR I=1 TO NZ:PRINT NZ$(I);" ";:NEXT L:PRINT 

640 PRINT:INPUT "EXpression : Nom zone=xxxx#Nom zone=#Nom zone>999 ";X$ 
650 GOSUB 890 

660 ! 

670 PRINT 

680 FOR NE=1 TO LOF(1) " Lecture de tout le fichier 

690 GET #1,NE 

700 IF ASC(ZN$(1))=0 THEN 820 

710 FOR K=1 TO NZ:TV(K)=0:NEXT K 


720 FOR K=1 TO NZ " Constitution de table de verite TV() 

730 IF OPE$(K)="" THEN 760 

740 IF OPE$(K)="=" THEN IF CRIT$(K)=LEFT$(ZN$(K) ,LEN(CRIT$(K))) THEN TV(K)=1 
750 IF OPE$(K)=">" THEN IF CVS(ZN$(K))>VAL(CRIT$(K)) THEN TV(K)=1 

760 NEXT K 

770 RESUL=1 

780 FOR K=1 TO NZ " Test table de verite TV() 

790 IF OPE$(K)<>"" THEN RESUL=RESUL#TV(K) 

800  NEXT K 


810 IF RESUL=1 THEN PRINT ZN$(1);ZN$(2);ZN$(3);ZN$(4) ;CVS(ZN$(5)) 
820 NEXT NE 


830 RETURN 

84Q 
850 ! Analyse de l'expression X$ 

860 ! 

870 ‘ SPGM Constitution table OPE$() et CRIT$() 
880 

890 FOR I=1 TO NZ:OPE$(I)="":CRIT$(I)="":NEXT I 

900 CUR=1 

910 ! 

920 DEP=CUR 

930 ‘ 

940 Y$=MID$(X$,CUR, 1) 

950 

960 IF Y$="=" THEN GOSUB 1040 :CUR=CUR+1:GOTO 920 


970 IF Y$=">" THEN GOSUB 1040 :CUR=CUR+1:GOTO 920 
980 IF Y$="*" THEN GOSUB 1110 :CUR=CUR+1:GOTO 920 
990 IF Y$="" THEN GOSUB 1110:RETURN 

1000 CUR=CUR+1 

1010 GOTO 940 

2020 
1030 Recherche nom de zone 

1040 NZ$=MID$(X$, DEP, CUR-DEP) 

1050 FOR I=1 TO NZ 

1060 IF NZ$=NZ$(I) THEN OPE$(I)=Y$:PT=I1: RETURN 
1070 NEXT I 

1080 RETURN 

1090 1" 
1100 Recherche critere 

1110 CRIT$=MID$(X$, DEP, CUR-DEP) 

1120 CRIT$(PT)=CRITS$ 

1130 RETURN 

DO = 
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LISTE DE CABLAGE 
Problème : il s'agit de relier entre eux, différents points 
d'une carte à wrapper : 


- Chaque groupe de points est défini par un nom (équipotentielle) 
- Les points de wrapping doivent être reliés en quinconce. 
On entre d'abord tous les points à relier en fournissant 
pour chacun d'eux : 
- Le nom de l'équipotentielle à laquelle il appartient 
- Ses coordonnées d'implantation (abscisse, ordonnée) 


Un tri est ensuite effectué sur la table des équipotentielles 
de façon à rapprocher tous les points appartenant à la même 
equipotentielle. 


L'édition des points est faite d'abord pour la couche basse 
puis pour la couche haute. 


eouig() Coorp3() 


se. 


eLEs Points De WRAPPING Doi venT 
cTRe Reles En QUIiNCONCE 


COUCHE HAUTE 
COUCHE BASSE 
a” 


TABLE DES GQUIPOTENTIELLES TRIÉES 


98 


LE BASIC ET SES FICHIERS 


20 ! Programme de LISTE de CABLAGE 

30 2222222222222222222222222222z 

40 

45 NOMBRE =8 " 8 points a cabler 
50 DIN EQUI$(NOMBRE+2) ,COORD$ (NOMBRE+2) 

EG Points a cabler 


60 DATA +5,A1-3,+5,A2-1 

62 DATA +5,B2-8 ,-5,B2-3 

63 DATA -5,C3-2,ALPHA,B3-5 
64 DATA BASC,A1-5 ,BASC, AU-3 
69 ! 

70 FOR I=1 TO NOMBRE 

80  READ EQUIS$(I) 

90  READ COORD$(I) 

100 NEXT I 

0 Tri des tables 
140 K=NOMBRE-1 

150 INVERSION=0 


160 FOR I=1 TO K 
170 IF EQUIS$(I+1)+COORD$(I+1)<EQUI$(I)+COORD$(I) 
THEN SWAP EQUI$(I+1) ,EQUI$(I):SWAP COORD$(I+1) ,COORD$ (I) : INVERSION=1 
180 NEXT I 
190 IF INVERSION=1 THEN K=K-1: GOTO 150 
200 


210 LPRINT:FOR I1=1 TO NOMBRE :LPRINT EQUIS$(I),COORD$(I):NEXT I:LPRINT 

20 
230 X=1 

250 LPRINT "Liste de CABLAGE" 

260 LPRINT "====222#=2x==2z#s=" :LPRINT 

eTo:" 

280 IF X>=NOMBRE THEN STOP 

290 DEBEQUI=X " DEBEQUI:memoire de X 

300 "——---- pas 

310 IF EQUIS$(X+1)=EQUI$(X) THEN LPRINT EQUIS$(X) ,COORD$(X);" ";COORD$(X+1);" Bas" 
320 IF EQUIS$(X+1)=EQUIS$S(X) AND EQUI$(X+2)=EQUI$(X+1) THEN X=X+2:GOTO 310 

330 "———- Haut 

340 X=DEBEQUI+1 

350 IF EQUIS$(X+1)=EQUI$(X) THEN LPRINT EQUI$(X) ,COORD$(X);" ";COORD$(X+1);" Haut" 
360 IF EQUIS$(X+1)=EQUIS$(X) AND EQUIS$(X+2)=EQUIS$(X+1) THEN X=X+2:GOTO 350 

370 IF EQUIS$(X+1)><EQUIS$(X) AND EQUIS$(X+2)=EQUIS$(X+1) THEN X=X+1:LPRINT :GOTO 280 E 
LSE X=X+2:LPRINT:GOTO 280 


380 

390 

+5 A1-3 
+5 A2-1 
+5 B2-8 
-5 B2-3 
5 c3-2 
ALPHA B3-5 
BASC A1-5 
BASC A4-3 


Liste de CABLAGE 


+5 A1-3 A2-1 Bas 
+5 A2-1 B2-8 Haut 
-5 B2-3 C3-2 Bas 
BASC A1-5 Al-3 Bas 
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GESTION DE CASIERS DE RANGEMENT 


Cet exemple de gestion de casiers de rangement devrait nous 
permettre de mettre en évidence la puissance de l'instruction 
FIELD# qui, en autorisant la définition de tables à plusieurs 
dimensions sur la mémoire tampon des fichiers, simplifie la 
programmation. 


, # 1 ALU EST REPRESENTÉS 
TRAVES 4 TRAUÉE 2 PAR UN ENREGISTREMENT 


Nous représentons chaque allée par un enregistrement de 256 
caractères. Les informations concernant chaque casier qui 
doivent être stockées sont la date et la quantité. 


Chacune de ces informations est stockée dans une table à 
deux dimensions : J8(TRAVEE,NIV) - M$ (TRAVEE,NIV) - etc... 
Les informations relatives à chaque produit telles que son 
code et son libellé sont stockées dans un fichier "PROD'. 


Les 'liens' entre les deux fichiers "CAS' et "PROD' permettent 
de retrouver 


1/ pour un casier, le code et le libellé associés (pointeurs 
PTS8(,)) 


2/ pour chaque produit, tous les casiers où il existe (pointeurs 
ALS(),TRAVS&(),NIVS#()) 


ACASIER 


FiCHiER 


Ficnier ‘'PRoj‘ 


pers Laver er LA Lt 4 Luisre pes casteas uk tr Propurr 
[eau nuxa T1 
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RANGEMENT 


.Permet de gerer des casiers de rangement 
.Chaque allee est representee par un enregistrement 


100 ! 
110 CLEAR (2000) 
120 DIM AL$(20),TRAVEES$(20) ,NIV$(20) 


130 ! 

140 ! 

150 OPEN "R",1,"CAS" " Fichier des casiers de rangement 
160 FIELD #1,127 AS D$,1 AS TEM$ " 253 AU LIEU DE 127 SUR TRS80 

170 OPEN "R",2,"PROD" " Fichier des produits 

180 FIELD #2,12 AS PP$,1 AS CLAS$,30 AS LIB$ 

190 FOR I=1 TO 20 " Pointeurs vers stock 


200 FIELD #2,60 AS D$,3#(1-1) AS D$,1 AS AL$(I),1 AS TRAVEE$(I),1 AS NIV$(I) 

210 NEXT I 

220 
230 ! TEM$ : Temoin d'initialisation 

240 GET #1,1:IF TEM$="#" GOTO 500 

250 PRINT:PRINT "INITIALISATION DU FICHIER 'CAS'":PRINT 


260 FOR 1=1 TO 20:GET #1,LOF(1)+1:PUT #1,I:NEXT I " Initialisation fichier avec 0 
ASCII 

270 LSET TEM$="#":PUT #1,1 

280 
290 

300 ! ALLEE : ALLEE 

310 ! TRAVEE : TRAVEE 

320 NIV : NIVEAU 

330 " 

340 ‘ FICHIER 'CAS': 

350 

360 J$(TRAVEE ,NIV) : JOUR 

370 M$(TRAVEE ,NIV) : MOIS 

380 ! A$(TRAVEE ,NIV) : ANNEE 

390 ! QT$(TRAVEE,NIV) : QUANTITE 

400 PT$(TRAVEE ,NIV) : POINTEURS VERS PRODUIT 

410 ! 

420 ' FICHIER 'PROD': 

430 ! 

44O ! PP$ : CODE PRODUIT 

450 ! AL$ (X) : POINTEURS VERS ALLEE (TABLE DIM(20)) 

460 ! TRAVEE$(X) : POINTEURS VERS TRAVEE 

470 ! NIV$(X) : POINTEURS VERS NIVEAU (TABLE DIM(20)) 

480 ! 

190 

500 FOR TRAVEE=1 TO 5 " 10 SUR TRS80 

510 FOR NIV=1 TO 3 

520 FIELD #1,24#(TRAVEE-1) AS D$,8#(NIV-1) AS D$,1 AS J$(TRAVEE,NIV),1 AS M$( 


TRAVEE ,NIV),1 AS AS$(TRAVEE ,NIV),2 AS QT$(TRAVEE,NIV),1 AS PT$(TRAVEE,NIV) 
530  NEXT NIV 

540 NEXT TRAVEE 

550 ! 
560 
570 ‘ 
580 
590 
600 
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650 " 

660 ! MENU 

670 ! 

680 PRINT TAB(20) "ST : STOCKAGE" 

690 PRINT 

700 PRINT TAB(10):INPUT "MODE? ";M$ 

710 IF M$="ST" THEN GOSUB 780 " Stockage 

720 IF M$="V" THEN GOSUB 1290 " Visualisation stockage 

730 IF M$="VP" THEN GOSUB 1450 " Visualisation produit 

740 GOTO 680 

750 ‘ 

760 ‘'====2==2===2=2=222=2==2=2222222=2=2=22222=2=22222-2=2=22=2222=2=2=2222==2=2=2=22222=2=22222=2=22222 
770 ! STOCKAGE 
780 PRINT:INPUT "PRODUIT? ";P$ 

790 IF P$="" THEN RETURN " Fin de mode 

800 FOR PD=1 TO LOF(2) " Recherche produit 


810 GET #2,PD 

820 IF P$=LEFT$(PP$,LEN(P$)) THEN GOTO 940 

830 NEXT PD 

840 

850 PRINT:INPUT "NOUVEAU PRODUIT OK ? ";R$:IF R$><"O" THEN 780 
860 GET #2,LOF(2)+1 

870 LSET PP$=P$ 

880 INPUT "CLASSE? ";X$:LSET CL$=X$ 

890 INPUT "LIBELLE? ";X$:LSET LIB$=X$ 


900 PD=LOF(2) " LOF(2)+1 SUR TRS80 

910 PUT #2,PD 

920 ‘ 

930 Recherche d'un casier libre 


940 PRINT:PRINT PP$,LIB$,CL$ 
950 FOR ALLEE=1 TO 10 


960 GET #1,ALLEE " Lecture d'une allee 
970 FOR TRAVEE=1 TO 5 " 10 SUR TRS80 

980 FOR NIV=1 TO 3 

990 IF CVI(QT$(TRAVEE,NIV))=0 THEN 1060 

1000 NEXT NIV 


1010 NEXT TRAVEE 

1020 NEXT ALLEE 

1030 

1040 PRINT "C'EST PLEIN" : STOP 

1050 

1060 PRINT:PRINT "ALLEE ; TRAVEE ;NIVEAU:" ; ALLEE ; TRAVEE NIV; "LIBRE ";:INPUT "OK? ";R$: 
IF R$©@"O" THEN 780 

1070 PRINT:INPUT "QUANTITE? ";QT:LSET QT$(TRAVEE,NIV)=MKIS$( QT) 

1080 ! 

1090 INPUT "JOUR? ";X:LSET J$(TRAVEE ,NIV)=CHR$(X) 

1100 INPUT "MOIS? ";X:LSET M$(TRAVEE,NIV)=CHR$(X) 

1110 LSET PT$(TRAVEE ,NIV)=CHR$(PD) " pointeur produit 
1120 FOR K=1 TO 20 " pointeur casier 
1130 IF ASC(AL$(K))=0 THEN LSET AL$(K)=CHR$(ALLEE) :LSET TRAVEE$(K)=CHR$(TRAVEE) : 
LSET NIV$(K)=CHR$(NIV):GOTO 1170 

1140 NEXT K 

1150 PRINT "PLUS DE PLACE POUR LES POINTEURS" : STOP 

1160 

1170 PUT #1,ALLEE 

1180 PUT #2,PD 

1190 GOTO 780 
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1280 ‘ VISUALISATION RANGEMENT 
1290 LPRINT:LPRINT "OCCUPATION DES CASIERS DE RANGEMENT" :LPRINT 

1300 FOR ALLEE=1 TO 10 

1310 GET #1,ALLEE 

1320  LPRINT "Allee:";ALLEE:LPRINT 

1330 FOR NIV=1 TO 3 


1340 FOR TRAVEE=1 TO 5 " 10 SUR TRS80 

1350 LPRINT USING "###";CVI(QT$(TRAVEE, NIV)); 

1360 X=ASC(PT$(TRAVEE,NIV)):IF X><O THEN GET #2,X:LPRINT " ";PP$; ELSE LPRINT SPC(12+1); 
1370 NEXT TRAVEE 

1380 LPRINT 


1390  NEXT NIV 
1400  LPRINT 
1410 NEXT ALLEE 
1420 RETURN 


1440 ! VISUALISATION STOCKAGES POUR UN PRODUIT 
1450 PRINT:PRINT:INPUT "QUEL PRODUIT? ";P$ 
1460 IF P$="" THEN RETURN 
1470 FOR PD=1 TO LOF(2) ‘ Recherche produit 
1480 GET #2,PD 
1490 IF P$=LEFT$(PP$,LEN(P$)) THEN 1540 
1500 NEXT PD 
! 


1510 

1520 PRINT:PRINT "N'EXISTE PAS":PRINT:GOTO 1450 

1530 

1540 PRINT:PRINT PP$; " PP$:code produit 

1550 FOR I=1 TO 20 " 20 pointeurs pour un produit 

1560 IF ASC(AL$(I))=0 THEN 1610 

1570 ALLEE=ASC(AL$(I)):GET #1,ASC(AL$(I)) " Lecture d'une allee 


1580 TRAVEE=ASC(TRAVEES$(1I)) 

1590 NIV=ASC(NIVS$(I)) 

1600 PRINT ALLEE ; TRAVEE ;NIV;"QT:";CVI(QT$(TRAVEE,NIV));"# "; 
1610 NEXT I 

1620 GOTO 1450 


OCCUPATION DES CASIERS DE RANGEMENT 


Allee: 1 
5 SUCRE 4 EAU 0 0 0 
6 EAU 0 0 0 0 
8 SUCRE 0 0 0 0 
Allee: 2 
0 0 0 0 0 
0 0 0 0 0 
0 0 0 0 0 
Allee: 3 
0 0 0 0 0 
0 0 0 0 0 
0 0 0 0 0 
Allee: 4 
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EVALUATION D'EXPRESSIONS 


Etudions comment peut être réalisée l'évaluation d'une 
expression arithmétique. Ce n'est pas, bien sûr, pour le seul 
plaisir de réinventer ce que fait un compilateur ou un inter- 
préteur. Nous aurons en effet besoin plus loin, d'évaluer des 
expressions de 'listes' (cf. langage d'interrogation de fichiers). 


L'analyse d'une expression se fait de gauche à droite. Chaque 
opérande rencontré est mis dans une pile dite "pile des opérandes', 
chaque opérateur étant lui stocké dans une ‘pile des opérateurs. 


À chaque fois qu'un opérateur de puissance inférieure ou égale 
à celle de l'opérateur du haut de la pile est rencontré dans 
l'expression à évaluer, (+ est moins puissant que %X), on évalue 
le résultat de l'opération entre les deux opérandes du haut de 
la pile avec l'opérateur du haut de la pile, puis le résultat 
est rangé à la place des deux précédents opérandes. Enfin, 
l'opérateur du haut de la pile est supprimé. 


asb+csd 


Ici, ON EVALUE O#æb 


asb+ced 


EL 
FH) Fr 


ICI, ON EVALUE cæd 
Puis (asb)+(ced) 


SEL 
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Lorsque l'expression à évaluer comporte des parenthèses, 
celles ouvrantes sont stockées systématiquement dans la pile 
des opérateurs. Considérées plus puissantes que les opérateurs, 
elles empêchent l'évaluation tant qu'une parenthèse fermante 
n'est pas rencontrée. Chaque parenthèse fermante provoque 
l'évaluation jusqu'à la parenthèse ouvrante correspondante. 


au((b+rcrd)# (e+f)+gsh 


Ii, on €varuE b+c 


a ((b+c+d )# (e+f)+9eh 


LcI, ON EVALUE d+(b+c) 


ax ((b+c+d ) # (e+f)+ gækh 


l 


ICI, ON ÉVALUE €+ j 


as((b+ic+d )s (e+f) + g<b 


ICI)ON EVALLE 


(b+c+d ) * e+f 
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Remarques sur le programme 


compte tenu des temps de traitement 


des chaînes de caractères, ce programme est relativement long 
à exécuter. Nous n'avons considéré que les opérations d'addition 
et de multiplication, celles dont nous aurons besoin plus loin. 


QUELLE EXPRESSION ? 


PLACER ( Dans 
LA PILE OPERATE 


EVALUATION 


e CVALUER LES 2 OPERANDES 
DU hauT De LA PILE OPERANDE 
AVEC L'OPERATEUR DU HAUT De 


Pile OPCRATEUR 

e PLACER LE RESULTAT A LA 
PLACE DS 2 OPERAN DES 
EVALVES 


oui 


EXTRACTION D'UN CARACTERE 
De L'exPRESSion 


RANÇER OPERANDE COURANT 
DANS LA Pile 


LU EST-iL MOINS PUIS 
QUE CŒLui DU HAUT 


EVALUATION 


PLACER L'OPERATEUR 
LU DANS LE HAUT 
DE LA Pire 


PLACER OPERAN De 
COURANT DANS LA PILE 


HAUT de 


LA Pire = "( 
? 


oui 


EVALUATION 
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30 ' EVA 12.5.80 EVALUATION D'UNE EXPRESSION 

4O ! Sen ee mem St CUS mm mes 

50 ! 

60 ! RTEUR$: pile operateurs RT : pointeur pile operateurs 

70 ! RANDE : pile operande RD : pointeur pile operandes 

80 ! 

90 X$="2#((1+2+3)#(2+3))+15" ‘ Expression a evaluer 

100 DEF FNY(Y$)=INSTR(" #4+)(",Y$) " Affectation d'un poids a #,+,),( 
105 ! (1,2,3,4) 

110 ! 

120 RT=1:RD=1 " RT:pointeur pile operateur/ RD:pointeur pile operande 
130 CUR=1 " Curseur 

140 ! 

150 DEP=CUR " Memoire ancienne position curseur 

160 ! 

170 Y$=MID$(X$,CUR, 1) ‘ Y$: caractere analyse 

180 


190 IF Y$="" THEN Y$=")": GOSUB 280:LPRINT:LPRINT "RANDE(1)=";RA(1):STOP 
200 IF Y$="+" THEN GOSUB 280 :CUR=CUR+1:GOTO 150 
210 IF Y$="#" THEN GOSUB 280:CUR=CUR+1: GOTO 150 
220 IF Y$=")" THEN GOSUB 330 :RT=RT-1::CUR=CUR+1::GOTO 150 
230 IF Y$="(" THEN RTEURS$(RT)=Y$:RT=RT+1:CUR=CUR+1:GOTO 150 
240 CUR=CUR+1 
250 GOTO 170 
' 


260 = 
270 ! PLUS/MULT 
280 GOSUB 440 ‘ Appel pile operande 


290 IF RT>1 AND FNY(Y$)>=FNY(RTEURS$(RT-1)) THEN GOSUB 380:RT=RT-1 :GOTO 290 

300 RTEUR$(RT)=Y$:RT=RT+1 

310 RETURN 

320 Parenthese fermante 

330 GOSUB 440 

340 IF RT>1 AND FNY(Y$)>=FNY(RTEUR$(RT-1)) THEN GOSUB 380:RT=RT-1:GOTO 340 

350 RETURN 
a Evaluation 

380 FOR I=1 TO RT-1:LPRINT RTEURS$(I);:NEXT I 

390 LPRINT TAB(10); :FOR I=1 TO RD-1:LPRINT RANDE(I);:NEXT I:LPRINT TAB(30);RT;RD 

400 IF RTEUR$(RT-1)="#" THEN RANDE(RD-2)=RANDE (RD-1)#RANDE (RD-2) : RD=RD-1 : RETURN 

410 IF RTEUR$(RT-1)="+" THEN RANDE(RD-2)=RANDE (RD-1)+RANDE (RD-2) : RD=RD-1 : RETURN 

D20 Ajout pile operande 

44O CH$=MID$(X$,DEP,CUR-DEP) " CH$:operande 

450 IF CH$="" THEN RETURN 

460 RANDE (RD)=VAL(CH$) 


470 RD=RD+1 

480 RETURN 

490 * +! 131! 

500 LiC0t 121! <-- RD 
510 ! RT > 1! (! 111 

520 [#1 121! 

530 " ———- en 

540 operateurs operandes 
550 ! RTEUR$() RANDE() 
#CC+ 2. Ar 2 5 4 

*CC+ 2 3 3 5 4 
#(#(+ 2:16". 181 3 6 5 

ss 2.6 5 4 4 

* 2 30 2 3 

+ 60 15 2 3 


RANDE(1)= 75 
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10 

20 

30 

40 

50 

60 

70 

80 

90 

100 
110 
120 
130 
140 
150 
160 
170 
180 
190 
200 
210 
220 
230 
240 
250 
260 
270 
280 
290 
300 
310 
320 
330 
340 
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INTER INTERSECTION DE 2 TABLES TRIEES 


Des 99999 ont ete places a la fin des tables A() et B() afin de simplifier 


LU 
' 
LU 
LU 
! Principe: On fait progresser J tant que A(I)>B(J) et I tant que A(I)<B(J) 
LU 
: le traitement 

! 

LU 


TABLE A TABLE B —----> TABLE C 

1! rstosméréis ss lésions 
‘ be fe HE A | 2 : 
‘ | 4 ii 2 | 4 
"ID 6 192! 3 
' LE AN Ces 
: 1! 
; 19999 :  ! 
; 1 9999 ! 
‘ 
' 


DIM A(20),B(20),C(40) 
1! 


FOR 1=1 TO 10 :A(I)=2#I:NEXT I * Sequence d'essai 
FOR I=1 TO 15:B(I)=I:NEXT I 
FOR I=1 TO 20:PRINT A(I),B(I):NEXT I 


A(11)=9999:B(16)=9999:GOSUB 300:FOR I=1 TO K-1:PRINT C(I):NEXT I 
' INTERSECTION DE A() ET B() 
I=1:J=1:K=1 

' 

IF A(1)=9999 AND B(J)=9999 THEN RETURN 

L 

IF A(I)=B(J) THEN C(K)=A(I):I=1+1:J=J+1:K=K+1:GOTO0O 320 ELSE 


IF A(I)<B (J) THEN I=I+1:GOTO 320 ELSE 
IF A(I)>B(J) THEN J=J+1:GOTO 320 


I=21:Je4:k=4 
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Principe: On analyse les tables À et B en faisant progresser 
I si A(I)<B(J) et J si A(I)>B(J) 


De facon a simplifier le traitement ,nous placons des 9999 
a la fin des tables A() et B() 
Pour trier des chaines de caracteres nous placerions des 'ZZZZZ1' 


1! 

: TABLE A TABLE B —---> TABLE C 

U PRES ARE ECEEEE, RS. -NEREREREE TES 2, PRET SR EN 
L ir :à i i 1 1 i 1 ï 
"1 5 4 ï 1 2 i 1 2 "1 
! 1 6 i 1, +3 Û 1 3 
! 1 8 iJ—>; 4 ' K—2! 4 1 
; i 1 0 Û i i 
t i 9999 : 1 ï i i 
: i 9999 Û i 
! Û ï 
' 

D 


IM A(20),B(20),C(40) 


FOR I=1 TO 10 :A(I)=2#I:NEXT I " Sequence d'essai 
FOR I=1 TO 15:B(I)=I:NEXT I 
FOR 1=1 TO 20:PRINT A(I),B(I):NEXT I 


STOP 

' FUSION DE A() et B() 
1=1:J=1:K=1 

| 


IF A(I)29999 AND B(J)=9999 THEN RETURN 
' 
JF A(I)<B(J) THEN C(K)=A(I):I=1+1:K=K+1:GOTO 340 ELSE 
IF B(J)<A(I) THEN C(K)=B(J):K=K+1:J=J+1:GOTO 340 ELSE 
IF A(I)=B(J) THEN C(K)=A(I):K=K+1:I=1+1:J=J+1:GOTO 340 


# FUSion Dé 2 TABLES TRiéES 
AG): BG) 
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INTERROGATION DE FICHIER PAR UNE EXPRESSION 
(cf. listes inverses et évaluation d'une expression) 


Nous vous proposons de réaliser ici, aussi simplement que 
possible, l'interrogation d'un fichier par une expression. 


Contrairement à l'exercice précédent (INTF) où nous analy- 
sions systématiquement chaque enregistrement du fichier pour 
déterminer s'il répondait ou non aux critères recherchés, nous 
utilisons des listes inverses précédemment constituées à l'a- 
jout de chaque enregistrement) qui pointent vers les seuls 
enregistrements susceptibles de répondre aux critères demandés. 


mctej{) MCLeg(2) 


FÎCHIER LISTES INVERSES 
Fichier PRINCIPAL 


POINTEURS PLOMBIERS 
POINTEURS VERSAILLES 


XX.() POIiNTEURS 
ee w-[3151] Ver (srl 7] momgices 
+ v [1313] A De veRSAiL LES 
Pite PILE OPERAN)E LA TABle XA() EsT 
OPERA TŒURS TV) TRANGFERE DANS LE 
HAUT DE LA PILE OPERAaNdE 


Pour simplifier la programmation, nous avons banalisé les 
mots-clés des professions et des villes, sachant qu'ils ne 
sauraient coincider. (Il y a peu de chance pour qu'un nom de 
profession coincide avec un nom de ville). 


RECHERCHE DU TYPE "ET' 


Exemple : Pour retrouver tous les enregistrements correspondant 
aux PLOMBIERS de VERSAILLES, nous recherchons tous les pointeurs 
des plombiers ainsi que ceux des personnes habitant 

Nous les rangeons dans une table T3(,), leur intersection fournit 
la liste des PLOMBIERS de VERSAILLES. 


Jusqu'à 110 pointeurs par mot-clé sont disponibles avec le 
programme présenté. 
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EVALUATION D'UNE EXPRESSION 

Un mode plus élaboré permet d'évaluer une expression du 
type : PLOMBX (VERS+BOUL) 
PLUSIEURS MOTS-CLES PAR ENREGISTREMENT DU FICHIER LISTES 
INVERSES 


Pour économiser l'espace disque occupé par le fichier listes 
inverses, plusieurs mots-clés par enregistrement sont définis 
(3 par exemple). La table des pointeurs PT8() à une dimension 
devient une table PTS#(,) à deux dimensions. 


PX$(1) PT$(1,x) PX$(2) PT$(2,x) PT$(3,x) 
Pure] +[+ ] IRESI [+] [ fes [ [I] 


.L'instruction FIELD # s'ecrit: 


FOR J=1 to 3 
FOR I=1 to 30 " 30 pointeurs par mot-cle 
FIELD #2,84#(J-1) AS D$,15 AS PX$(J),2#(I-1) AS D$,2 ASD PT$(J,1) 
NEXT I 
NEXT J 


a/ .La constitution des tables CLE$() et IX#() en debut de session devient: 


910 PRINT "MOT-CLE" 
920 FOR NI=1 to LOF(2) 
GET #1,NI 
FOR P=1 TO 3 
IF ASC(PX$(P))=0 THEN GOTO 950 
PRINT PX$(P):NB=NB+1:CLES$(NB)=PX$(P):IX#(NB)=NI#3+P 
NEXT P 
950  NEXT NI 


.On code dans IX#() la valeur NI#3+P 1X40) 


pe =] 
DER 


b/ La mise a jour des listes inverses se fait par: 


CLE$() 1X40 P=1 P=2 P=3 


NI: No enregistrement du fichier listes inverses 
P : Position dans cet enregistrement (1,2,3) 
NB: Nombre de cles dans la table CLE$() 
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710 FOR V=1 TO NMCLES 
720 IF ASC(MCLE$(V))=0 THEN GOTO 860 
730 PRINT MLE$(V) 


740 FOR K=1 TO 150 " Recherche du mot-cle 
750 IF MCLE$(V)=CLE$(K) THEN NI=INT((IX#4(K)-1)/3): 

P=(CIX#(K)-1) MOD 3)+1:GOTO0 810 " Le mot-cle existe 
760 IF CLE$(K)="" THEN P=((K-1) MOD 3)+1:NI=INT((K-1)/3)+1: 


CLE$(K)=MCLE$(V):1IX#(K)=NI#3:NB=NB+1:GOTO 810 ‘Ajout mot-cle 
770 NEXT K 


810 GET #2,NI 


820 FOR 1=1 TO 30 " Ajout pointeur 
830 IF CVI(PT$(P,1))=0 THEN LSET PT$(P,I)=MKI$(NE) : 
LSET PX$(P)=CLE$(K):PUT #2,NI:GOTO 860 
840  NEXT I 
860 NEXT V 


c/ .Pour la recherche dans le fichier listes inverses,le decodage du contenu de IX#() 


se fait par: 


1430 NI=INT((IX#(1)-1)/3) * No d'enregistrement fichier liste inverse 
1432 P =((IXZ(I)-1) MOD 3)+1 " Position dans l'enreg (1,2,3) 
1434 GET #2,NI 


1460 NE=CVI(PT$(P,K)) " NE: No d'enregistrement fichier principal 


L'allocation dynamique des enregistrements du fichier prin- 
cipal n'ayant pas été prévue, une réorganisation de celui-ci 
(par retassage) sera faite dès que les suppressions seront 
devenues trop nombreuses. Il faudra alors recréer les listes 
inverses (mode 'CRI'). 
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10 CLEAR(3000) 
20 PRINT “BASE/BAS 6.1.81":PRINT 


30 

4O " INTERROGATION D'UN FICHIER PAR UNE EXPRESSION 

50 ‘ 

Le | SYNTHESE: EVALUATION D'UNE EXPRESSION+LISTES INVERSES 
0 

80 " EX: PLOMBIER*(VERSAILLES+SEVRES )+CARRELEUR*VERSAILLES 

90 ‘ 

100 A CHAQUE MOT-CLE EST ASSOCIE UNE LISTE DE POINTEURS VERS 
110 ‘ LES ENREGISTREMENTS DU FICHIER PRINCIPAL OU IL EXISTE 

120 

130 ‘ ON EVALUE UNE EMPRESSION PAR INTERSECTIONS ET UNIONS SUCCESSIVES 
140 " DE LISTES DE POINTEURS. 


150 NMCLES=4 " Nombre de MOTS CLES par enregistrement 
160 COM$(1)="MOT-CLE1" : COM$(2)="MOT-CLE2 " : COMS(3)="MOT-CLE 3" : COMS (4 )="MOT-CLE4 
170 DIM PT$(110),CLES(50) 


180 DIM T4(5,110) " Pile operandes (hauteur=5)9 
190 DIM X%(200) " Table des operandes 
200 OPEN “R",#1,"BASE" " Fichier principal 


210 FOR I=1 TO NMCLES:FIELD #1,50 AS NOMS,(I-1)*15 AS DS, 
15 AS MCLES(I):NEXT I 
220 OPEN "R",#2,"IBASE" " Fichier listes inverses 


230 FOR 1=1 TO 110 :FIELD #2,15 AS PX$,(1-1)*2AS D$,2 AS PT$S(I):NEXT I 
240 GOSUB 900 


250 "mm 22222222=222=222=222m2222 


260 MENU 

270 PRINT:PRINT ” PENSER A FAIRE ‘FIN ‘" “:PRINT 

280 PRINT :INPUT “MODE? (C,CRI,RCLE, INT, LF,FIN,-+)";MODES 

290 IF MODES$="C" THEN GOSUB 410 "Creation 

300 IF MODES="CRI" THEN GOSUB 560 ‘Creation liste inverse 

310 IF MODES$="RCLE" THEN GOSUB 1000 ‘Recherche pour un MOT-CLE 

320 IF MODE$S="ET" THEN GOSUB 1660 ‘Mode ET 

330 IF MODES="OU" THEN GOSUB 1770 

340 IF MODES="INT" THEN GOSUB 2540 ‘Interrogation par une expression 


350 IF MODES$="LF" THEN GOSUB 2310 

360 IF MODES="SU" THEN GOSUB 2380 

370 IF MODE$="FIN" THEN CLOSE #1,#2:CMD "S" 
380 GOTO 280 


390 ‘mm 2"22222222-=2=-222222222222 


400 " CREATION(C) 
410 PRINT :X$="":INPUT “NOM ";X$S:IF X$=""THEN RETURN 

420 NE=LOF(1)+1:GET #1,NE " Ajout en fin de fichier 
430 LSET NOM$=XS$ 

440 


450 FOR K=1 TO NMCLES 

460 Y$="":PRINT COMS(K);: INPUT Y$ 

470 IF YS><"" THEN LSET MCLES(K)=Y$ 

480 NEXT K 

490 " 

500 PRINT:INPUT “OK (O/N) ";RS:IF R$<D>"O" THEN 410 

510 PUT#1,NE 

520 GOSUB 680 * Appel MAJ listes inverses 
530 GOTO 410 


540 ‘æmmmmmmmmm2222222222222222222222222222222=2222S2222222=22222222225 
550 CONSTITUTION LISTE [INVERSE(CRI) 

560 CLOSE#2:KILL “IBASE":OPEN "R",2,"IBASE" 

570 FOR I=1 TO 50:CLES$S(1)="":NEXT L:NB=0 

580 FOR NE=1 TO LOF (1) 

590  GOSUB 680 * Appel MAJ listes inverses 

600 NEXT NE 

619 CLOSE #2:0PEN "R",2,"IBASE" 

620 RETURN 

630 ‘ 
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670 ----- 
675 " MAJ LISTE INVERSE 
680 GET #1,NE:IF ASC(NOM$S)=0 GOT) 870 
690 PRINT:PRINT NOMS 
700 ‘ 
710 FOR V=1 TO NMCLES 
720 IF ASC(MCLES(V))=0 GOTO 860 
730 PRINT MCLES(V) 
740 FOR K=1 TO 50 " Recherche MOT-CLE 
750 IF MCLES(V)=CLES(K) THEN GOTO 819 
760 IF CLES(K)="" THEN CLES(K)=MCLES(V):NB=NB+1:GOTO 810 
770 NEXT K 
780 
790 PRINT'AUGMENTEZ LA TAILLE DE CLES":STOP 
800 
810 GET #2,K 
820 FOR I=1 TO 110 " Ajout d'un pointeur 
830 IF CVI(PTS(I))=9 THEN LSET PTS(I)=MKIS(NE): 
LSET PXS=CLES(K):PUT #2,K:GOTO 860 ‘ Pointeur libre? 
840 NEXT I 
850 PRINT'Y'A PLUS ASSEZ DE PLACE POUR LES POINTEURS" : STOP 
860 NEXT V 
870 RETURN 
880 ‘=== 22--2222222222222222=2222222222=222s2222 
890 CONSTITUTION DE LA TABLE CLES 
900 NB=0 " NB:nombre de cles 
910 PRINT "MOT-CLE":PRINT 
920 FOR I=1 TO LOF (2) 
930 GET #2,1:IF ASC(PX$)=0 GOTO 950 
940 PRINT PXS:NB=NB+1 :CLES(NB)=PXS 
950 NEXT I 
960 PRINT 
970 RETURN 
CE 
990 ‘ INTERROGATION PAR MOT-CLE(RCLE) 
1000 PRINT:X$="":INPUT “"MOT-CLE CHERCHE ? ";XS:IF X$="" THEN RETURN 
1010 ‘ 
1020 FOR I=1 TO NB 
1030 IF X$S=LEFT$S(CL$S(I),LEN(XS)) THEN GOTO 1080 
1040 NEXT I 
1050 
1060 PRINT “MOT-CLE N'EXISTE PAS":PRINT : GOTO 1000 
1070 
1080 GET #2,1:PRINT 
1090 
1100 FOR K=1 TO 110 
1110 NE=CVI(PT$S(K)):IF NE=0 THEN GOTO 1140 
1120 GET #1,NE 
1130 PRINT NOM$ 
1140 NEXT K 
1150 GOTO 1000 
1160 
1170 
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1479 
1489 
1499 
1500 
1510 
1529 


1539 
1540 
1559 
1555 
1560 
1580 
1590 
1600 
1510 
1620 
1539 
1640 
1650 
1660 
1679 
1689 
1690 
1700 
1710 
1720 
1730 
1740 
1750 
1760 
1770 
1780 
1790 
1800 
1310 
1320 
1830 
1840 
1850 
1860 
1870 
1880 
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RECHERCHE POINTEURS POUR UN CRITERE 


PRINE :X$="": INPUT “HOT-CLE CHERCIC? “3XS:IF XS="" THEN VLO=2: RETURN 
CES(P)=XS : P=P+1 


FOR I=l TO uÿ 
[5 XS$=LEFTS(CLES(I),LEN(XS)) TilEN 1420 
NEXT L 
LU 
PILENE "AOT-CLE N'EXISTE PAS": PRINT: VLD=2 : RETURN: GOTO 1340 
L 
GET #2,1 
' 
FOR <=L TO 110 
NESCVI(PTS(K)):IF NE=) THEN T£(V,K)=9999:GOT0 1500 
TACV, RKJSNE 
NEXT K 
-- TRI DE TVZ(V,) 
LAV=0 
FOR I=l TO K-1 
Fr Té(V,LDDTA(V, I+1) THEN K=T4(V, 1): 
TACV,I)=TZ(V,I+1):T2(V,I+1)=X: INV=1 
NEXT L 
IF INV=0 THEN VLN=1:RETURN ELSE GOTO 1500 
, INTERSECTION DE 2 LISTES 
I=l:J=1:K<=1 
® Le resultat est range DANS TZ(V,) 
IF TA(V,1)=9999 THEN T4(V,K)=9999 : RETURN 
IF TA(V,I)<TZ(W,J) TUEN I=I+1:GOTO 1590 
IF TA(V,L)DTX(W,J) TUEN J=J+1:GOTO 1590 
LF TACV,I)=TACW,J) TUEN TÆ(V,K)=TÆ(V,1):1=1+1:J=J+1:K=K+l:GOTO 1590 
STOP 
SR RP ER EE D TE RE SR IE ES PSE RES Sete PAPE CSS OISE RER 
: RECHERCHE OÙ TYPE ‘ET! 
FOR I=l TO 5:CCS(I1)="":NEXT L:P=1 
V=1:GOSUB 1340:O0N VLD GOTO 1590,1680 " Appel premier MOT-CLE 
RETURN 
V=2:GOSUB 1340:ON VLD COTO 1710,1700 " Appel second MOT-CLE 
GOTO 1560 
V=l:W=2:GOSUB 1560 * Appel intersection 
OPS(P-2)="* " 
GOSUB 2170 


GOTO 1690 " Appel edition 
l==== RASS222ZL=2SS===SLI=S=SSILLIS==LL=L=I=2=====222222=2==22=2==2=22 
d RECHERCHE OÙ TYPE "OU" 


FOR I=l TO 5:CC$(I)="":NEXT I:P=1 

V=1:GOSUB 1340 :ON VLD GOTO 1800,1799 " Appel premier MOT-CLÉ 
RETURN 

V=2:GOSUB 1340:ON VLD GOTO 1820,1810 " Appel second MOT-CLE 
GOTO 1770 


V=1:W=2:GOSUB 2040 " Appel fusion 
OPS(P-2)="+ " 
GOSUB 2170 * Appel edition 
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LE BASIC ET SES FICHIERS 


I=l:J=1:K=1 


IF TÆ(V,1)=9999 AND TX(W,J)=9999 THEN X#(K)=9999 :GOTO 2110 

IF TA(V,I)<TA(W,J) THEN X#(K)=T#(V,I):1=1+1:K=K+1:GOTO 2060 

IF TA(V,IL)DTX(W,J) THEN X#(K)=T#(W,J):J=J+1:K=K+1:GOTO 2060 

IF TX(V,L)=TX(W,J) THEN X4(K)=T4(V,1):I=1+1:J=J+1:K=K+1:GOTO 2060 
: 


FOR I=1 TO 200 


FUSION DE 2 LISTES 


IF X%(1)=9999 TAEN TÆ(V,1)=X%(1):G9TO 2150 


NE=T#(1,K):IF NE=9999 OR NE = O THEN PRINT :GOTO 2270 


lmm==2==222222=2222222222222222=222222222222222==22=2=2=222=222222=22 


lmmm2222=22222=22=222222=222-22=2222222222S2S2SS2SSSSSSS=2S22SS2S22SSS 


TA(V,1)=X#4(1) 

NEXT IL 
RETURN 
UN se CN fre pen 4 LR nee 
! 
PRINT: PRINT 
FOR I=1 TO 5 

IF CC$(I)><"" AND CC$(I+1)><"" THEN 

PRINT CCS(I);0P$(I);:GOTO 2210 

IF CCS(I)><"" THEN PRINT CCS(I); 
NEXT I 
PRINT: PRINT 
FOR K=1 TO 200 

GET #1,NE:PRINT NE; LEFTS(NOMS, 30) ; MCLES(1); MCLES(2) 
NEXT K 
RETURN 
ù 
! 
PRINT:FOR I=l TO LOF(1) 
GET #1,1:IF ASC(NOMS)=0 GOTO 2340 

PRINT I;LEFTS$(NONS, 30) ; MCLES$(1);MCLES(2) 
NEXT I 
RETURN 
LL 
PRINT:NE=0: INPUT “QUEL ENREGISTREMENT ";NE 


IF NE=0 THEN RETURN 


GET #1,NE: PRINT NOMS; :R$="":INPUT “ ANNULE OK (O/N) ";R$: 


IF R$<>"O" THEN 2380 
GET #1,LOF(1)+1:PUT #1,NE 
GOTO 2380 


! 
' 
0 
! 
0 
' 
! 
, 
! 
! 
' 
Ü 
! 
0 
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EDITION 


LISTE DU FICHIER(LF) 


MODE SUPPRESSION(SU) 


2520 
2525 
2526 
2530 
2535 
2540 
2545 
2560 
2570 
2580 
2590 
2600 
2610 
2620 
2630 
2640 
2650 


2660 
2670 
2680 
2690 
2700 
2710 
2720 
2730 
2740 


2750 
2760 
2770 
2780 
2790 


2800 
2810 
2820 
2830 
2840 
2850 
2860 
2870 
2880 
2890 
2900 
2919 
2920 
2930 
2940 
2950 
2960 
2970 
2980 
2990 
3000 


LE BASIC ET SES FICHIERS 


INTERROGATION PAR UNE EXPRESSION 


DEF FNY(YS)=INSTR(" *+)(",YS) " Affectation d'un poids À *,+ 
LU 


PRINT:EX$="": INPUT "EXPRESSION ";EXS 
IF EX$="" THEN RETURN 


RT=1 : RD=1 " Pointeurs piles operateurs et operandes 
CUR=1 " Curseur 

DEP=CUR 

LU 

YS$S=MIDS(EXS ,CUR, 1) " Caractere analyse 

L 


IF Y$="" THEN Y$=")":GOSUB 2730:IF VLD=1 THEN GOSUB 2220:GOTO0 2560 
ELSE GOTO 2560 

IF Y$="+" OR YS="*" THEN GOSUB 2730:CUR=CUR+1:GOTO 2610 

IF Y$=")" TUEN GOSUB 2780:RT=RT-1:CUR=CUR+1:GOTO 2610 

IF Y$="(" THEN RTEURS(RT)=Y$ : RT=RT+1 : CUR=CUR+1:GOTO 2610 

CUR=CUR+1 

GOTO 2630 

ts PLUS/MULT 


GOSUB 2870:1IF VLD=2 THEN RETURN " Appel pile operande 
IF RT>1 AND FNY(YS$)>=FNY(RTEURS(RT-1)) T:IEN 

GOSUB 2830:RT=RT-1:GOTO 2740 
RTEURS(RT)=Y$ : RT=RT+1 


= PARENTHESE FERMANTE 
GOSUB 2870 " Appel pile operande 
IF RTDL AND FNY(YS)>=FNY(RTEURS(RT-1)) THEN 

GOSUB 2830:RT=RT-1:GOTO 2790 


= EVALUATION 


IF RTEURS(RT-1)="*" THEN V=RD-2:W=RD-1:GOSUB 1560: RD=RD-1 : RETURN 
IF RTEURS(RT-1)="+" THEN V=RD-2:W=RD-1:GOSUB 2040: RD=RD-1 : RETURN 
5 AJOUT PILE OPERANDE 

CH$=MIDS(EXS ,DEP,CUR-DEP) " Operande 

IF CH$="" THEN RETURN 

X$=CH$ : V=RD:GOSUB 1360:1IF VLD=2 THEN RETURN 

RD=RD+1 

RETURN 

L 


! ! 
! ! 
! POINTEURS! <-- RD 
! POINTEURS! 
rteur$() t2(,) 
OPÉRATEURS OPERANDES 


RT ---»> 
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LE BASIC ET SES FICHIERS 


INDEX A DEUX NIVEAUX 
(cf. Basic et ses Fichiers, tome 1, p. 99) 


Un index continu sur disque en ordre croissant permet, grâce 
à une table d'index réduite en mémoire centrale, de retrouver 
une clé par un seul accès à l'index sur disque. Mais l'inser- 
tion d'une nouvelle clé oblige à décaler sur disque toutes les 
clés de l'index en aval de l'insertion, ce qui peut être très 
long. 


L'index à deux niveaux, par l'insertion dynamique de blocs 
dans l'index, évite ces décalages. La régénération d'un index 
en cas de destruction de celui-ci ou d'incohérence avec le 
fichier principal, doit être prévue. 


Deux solutions sont possibles : 


— On explore séquentiellement le fichier principal, et pour 
chaque clé, nous appelons les routines de recherche et de 
création de clé (déjà écrites). Cette solution simple à 
mettre en oeuvre conduit à des temps d'exécution longs. 


-— Toutes les clés du fichier sont amenées en mémoire centrale 
puis triées. Il suffit alors de sauvegarder cette table dans 
l'index. Rapide, cette méthode nécessite de la place mémoire 
pour les tables des clés et d'index. 
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130 
140 
150 
160 
170 
180 
185 
190 
200 
210 
220 
225 
230 
240 
245 
250 
260 
270 
280 
290 
310 
320 
325 
330 
350 
360 
370 
380 
390 
400 
410 
XT 

420 
430 
440 
450 
460 
480 
490 
500 
510 
530 
550 
555 
560 
565 
570 
580 
600 
630 
650 
660 
670 
690 
700 
710 


LE BASIC ET SES FICHIERS 


ID3 25.12.80 


INDEX a 2 NIVEAUX 


cf BASIC et ses FICHIERS p 99 


! 

! 
! 
! 
! 
' 
! 


CLE$() INDEX() FICHIER INDEX FICHIER PRINCIPAL 

LUCET xxXXXXXXXXX 
DUPOND FxxxxXXXXXXX 
MARTIN |XXXXXXXXXXX 


LIGNE-> RMART | -> 2 
L 


SCLE$() PT$() NM$ 


SCLE$(): Table definie dans FIELD# du fichier index 
RANG : Adresse de rangement dans le fichier principal 
ISER : Position d'insertion dans un enregistrement de l'index 


Au depart ,la table CLE$() est initialisee avec des '#! 


" Seules les premieres lettres des CLES sont enregistrees dans le fichier index 


" et la table CLE$() est sauvegardee dans l'enreg no 1 du fihier index 
! 


CLEAR(5000) 

DIM TC$(100),1IX#(100) 

LGCL=5 " LGCL:Longueur des cles dans le fichier index 

NCL=10 " NCL :(254/(LGCL+2) SUR TRS80 (Nb de cles par enreg) 


DIM PT$(NCL) ,SCLE$ (NCL) 
' 


DIM CLES$(NCL) ,INDEX(NCL) 

OPEN "R",1,"TOT" " Fichier principal 

OPEN "R",2,"ITO" " Fichier index 

FIELD #1,10 AS NM$,8 AS PREN$,20 AS TEL$ 

FOR I=1 TO NCL :FIELD #2,(LGCL+2)#(1-1) AS D$,(LGCL) AS SCLES$(I),2 AS PT$(I):NE 
T 

GOSUB 790 


PRINT:INPUT "Mode? (C,RI,LISTT,SUP,CRI..) ";M$ 
IF M$="C" THEN GOSUB 550 

IF M$="LISTT" THEN GOSUB 1700 

IF M$="SUP" THEN GOSUB 1820 


IF M$="CRI" THEN GOSUB 2010 " Creation index (si incident) 

GOTO 450 

PRINT:INPUT "Nom? ";NOM$:IF NOM$="" THEN RETURN " AJOUT d'UN NOM 
GOSUB 960:ON R GOTO 560,570 

PRINT:PRINT NM$:PRINT:GOTO 550 " Existe deja 

1! 

RANG=LOF(1):GET #1,RANG " LOF(1)+1 SUR TRS80 

LSET NM$=NOM$ 

INPUT "Prenom? ":X$:LSET PREN$=X$ 


INPUT "Telephone? ";X$:LSET TEL$=X$ 

U 

PRINT:PRINT TAB(30):INPUT "OK? ";R$:IF R$><"O" GOTO 550 

PUT #1,RANG 

GOSUB 1340 ' Appel MAJ index 
GOTO 550 

LU 


119 


LE BASIC ET SES FICHIERS 


790 ‘ Lecture de CLE$() sauvegarde dans enreg 1 de l'index 

800 GET#2,1 

810 IF ASC(SCLE$(1))=20 THEN PUT #2,1:PRINT "INITIALISATION INDEX" 

820 FOR I=1 TO NCL 

830 IF ASC(SCLE$(I))><0 THEN CLE$(I)=SCLE$(I):INDEX(I)=CVI(PT$(I)) ELSE CLE$(I)=" 


840 NEXT I 
850 RETURN 
' 


870 ne 
880 ‘ Sauvegarde de CLE$() 
890 FOR I=1 TO NCL:LSET SCLE$(I)=CLE$(I):LSET PT$(I)=MKIS$(INDEX(I)):NEXT I 
900 PUT #2,1:RETURN 
910 RETURN 

! 


RECHERCHE CLE 


U 
1! 
! 
960 L=LEN(NOM$) 
' 


980 IF LEFT$( CLE$(1),1)="#" THEN ALC=1:DECAL=0 : LIGNE=1:R=2: RETURN 
990 FOR I=1 TO NCL 
1000 IF NOM$=LEFT$(CLE$(I),L) OR CLE$(I)=LEFT$(NOM$,LGCL) THEN LIGNE=I-1:GOTO 10 


1010 IF NOM$<CLE$(I) THEN LIGNE=I-1:GOTO 1080 
1020 IF LEFT$(CLE$(I),1)="*" THEN LIGNE=I-1:GOTO 1080 
1030 NEXT I 
1040 STOP 

: Retour : R=1 :la cle existe / R=2 : elle n'existe pas 
1070 
1080 IF LIGNE<1 THEN LIGNE=1 
1090 GET #2,INDEX(LIGNE) 
1100 
1110 FOR J=1 TO NCL 
1120 IF NOM$<LEFT$(SCLE$(J),L) THEN ISER=J:R=2:GOTO 1220 
1130 IF CVI(PT$(J))=0 THEN IF NOM$<LEFT$(CLES$(LIGNE+1),L) OR LEFT$(CLES$(LIGNE+1), 
1)="#*" THEN R=2:ISER=J : ALC=0 : DECAL=0 : RETURN ELSE LIGNE=LIGNE+1:GOTO 1090 
1140 IF NOM$=LEFT$(SCLE$(J),L) OR SCLE$(J)=LEFT$(NOM$,LEN(SCLE$(J))) THEN GOTO 1 
150 ELSE GOTO 1180 
1150 GET #1,CVI(PT$(J)):1F NOM$=LEFT$(NM$,L) THEN RANG=CVI(PT$(J)):ISER=J:R=1:RET 
URN 


1160 ! 

1170 IF NOM$<LEFT$(NM$,L) THEN ISER=J:R=2:GOTO 1220 
1180 NEXT J 

1190 " 


1200 R=2:ISER=1:LIGNE=LIGNE+1:IF LEFT$(CLE$(LIGNE) ,1)="#" THEN ALC=1:DECAL=0 : RETURN 
ELSE GET #2, INDEX(LIGNE):GOTO 1090 

1210 

1220 IF CVI(PT$(NCL))=0 THEN ALC=0 : DECAL=0 : R=2 : RETURN 

1230 IF LEFT$(CLE$(LIGNE+1),1)="#" THEN ALC=1:DECAL=1:R2=2:RETURN 

1240 GET #2,INDEX(LIGNE+1) 

1250 IF CVI(PT$(NCL))><0 THEN ALC=1:DECAL=1:R=2:RETURN 

1260 DECAL=1:ALC=0 : R=2: RETURN 

1320 


1329 
1330 
1340 
1350 
1360 
1370 
1380 
1390 
1400 
1420 
1430 
1440 
1460 
1470 
1480 
1490 
1500 
1510 
1520 
1530 
1540 
1550 


1560 ! 


1570 
1580 
1590 
U 

1600 


LE BASIC ET SES FICHIERS 


! 

AJOUT CLE 

IF ALC=1 THEN IX=LOF(2) " LOF(2)+1 SUR TRS80 

IF ALC=0 AND DECAL=0 GOTO 1400 " IX:adresse fichier index 

IF ALC=1 AND DECAL=0 GOTO 1460 

IF ALC=0 AND DECAL=1 GOTO 1580 

IF ALC=1 AND DECAL=1 GOTO 1530 

LU 

GOTO 1580 " Alloc=0 : Decal=0 


! Alloc=1:Decal=0 
Ajout fin index 
INDEX(LIGNE)=1IX:CLES$ (LIGNE)=NOM$ 

GET #2,INDEX(LIGNE) :LSET PT$(1)=MKI$(RANG) :LSET SCLE$(1)=NOM$ 

PUT #2,INDEX(LIGNE) 


GOSUB 890 

RETURN 
lsphiimsstamsacesmsssasbmsmsitasatonsratonsomessbsinét émane 
! Alloc=1:Decal=1 

FOR I=NCL-1 TO LIGNE+1 STEP-1:CLES$(I+1)=CLES$(I):INDEX(I+1)=INDEX(I):NEXT I 


INDEX(LIGNE+1)=1X 

GOTO 1580 

' Alloc=0 :Decalz=1 
GET #2, INDEX(LIGNE) : T3$=PT$(NCL) : TH$=SCLE$ (NCL) 

FOR U=NCL-1 TO ISER STEP-1:LSET PT$(U+1)=PT$(U):LSET SCLES$(U+1)=SCLES$(U) : NEXT 


LSET PT$(ISER)=MKI$(RANG) :LSET SCLES$(ISER)=NOM$: PUT #2, INDEX(LIGNE) : CLE$ (LIGNE 


)= SRE) 


1620 
1630 
1640 
1650 
1660 
1670 
1680 
1690 
1700 
1710 
1720 
1740 
1750 
1760 
1780 
1790 
1800 
1820 
1830 
1840 
1850 
1860 
1870 
1880 
1890 
1900 
1910 
1920 
1930 
1940 
1950 


IF CVI(T3$)=0 THEN GOSUB 890 : RETURN 

LIGNE=LIGNE+1:GET #2, INDEX(LIGNE) 

T1$=PT$(NCL) : T2$=SCLE$ (NCL) 

FOR U=NCL-1 TO 1 STEP-1:LSET PT$(U+1)=PT$(U):LSET SCLE$(U+1)=SCLE$(U):NEXT U 
LSET PT$(1)=T3$:LSET SCLE$(1)=T4S$:PUT #2, INDEX(LIGNE) : CLE$ (LIGNE)=SCLES$ (1) 
13 T1$:TH$=T2$:GOTO 1630 


FOR I=1 TO NCL " LISTE TRIEE 
PRINT 
GET #2,INDEX(I) 
FOR J=1 TO NCL 
X=CVI(PT$(J)):IF X><O THEN GET #1,X : PRINT NM$ 
NEXT J 
NEXT I 
RETURN 
1SSouas === ==222=2=2222= SUPPRESION D'UNE CLE 
PRINT: X$= INPUT "CLE? ";X$:1IF X$="" THEN RETURN 
NOM$=X$:GOSUB 960:O0N R GOTO 1850, 1840 
PRINT "N'EXISTE PAS ":PRINT:GOTO 1820 
PRINT NM$;:R$="":INPUT "ANNULE OK? (O0) ";R$:IF R$<>"O" THEN GOTO 1820 
GOSUB 1880 
GOTO 1820 
FOR I=ISER TO NCL-1 
LSET SCLES$(I)=SCLE$(I+1):LSET PT$(I)=PT$(I+1) 
NEXT I 
LSET PT$(NCL)=MKI$(0) 
CLE$(LIGNE)=SCLES$ (1) 
PUT #2,INDEX(LIGNE) 
IF ASC(SCLE$(1))=0 THEN FOR I=LIGNE TO NCL:CLE$(I)=CLE$(I+1):INDEX(I)=INDEX(I+ 


1):NEXT I 


1960 
1970 


GOSUB 890 
RETURN 
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LE BASIC ET SES FICHIERS 


L CREATION INDEX (SI DESTRUCTION) 
! utilise 2 tables TC$() et INDEX() 


KILL #2:OPEN "R",#2,"ITO" 


FOR I=1 TO NCL:CLE$(I)="":INDEX(I)=0:NEXT I 

GOSUB 800 " Appel initialisation index 
IND=0 

FOR S=1 TO LOF(1) 


GET #1,S:IF ASC(NM$)=0 THEN 2100 
PRINT NM$,S 
IND=IND+1:TC$(IND)=NM$:IX#(IND)=S 
NEXT S 
NB=IND:GOSUB 2290 " Appel TRI 
a — —— Sauvegarde index trie 
K=1 
FOR I=2 TO NCL 
GET #2,1I 
FOR J=1 TO NCL 
LSET SCLE$(J)=TC$(K):LSET PT$(J)=MKI$(IX#(K)) 
IF K=IND THEN PUT #2,1:CLE$(I-1)=SCLE$(1):INDEX(I-1)=1:GOTO 2250 
K=K+1 
NEXT J 
PUT #2,1I 
CLE$(I-1)=SCLE$(1):INDEX(I-1)=1I 
NEXT I 
1! 
FOR I=1 TO NCL:LSET SCLE$(I)=CLE$(I):LSET PT$(I)=MKI$(INDEX(I)):NEXT I 
PUT #2,1 
RETURN 
| ER ORST ONE RER Sn PEL RER RTE EU D NRA RER ETES 
PRINT:PRINT "JE TRIE POUR VOUS NB=" ,NB:PRINT:ECART=NB 
! 
ECART=INT(ECART/2):I1F ECART<1 THEN RETURN 
J=1:K=NB-ECART 
' 
I=J 
! 
L=I+ECART 
IF TC$(I)<TC$(L) GOTO 2410 
SWAP TC$(L),TC$(I):SWAP IX#(L),IX#(I): 
I=I-ECART:IF I<1 GOTO 2410 ELSE GOTO 2360 
1! 
J=J+1:IF J>K GOTO 2310 ELSE GOTO 2340 
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LE BASIC ET SES FICHIERS 


ACCES INDEXE AVEC RECHERCHE DICHOTOMIQUE 


Le temps de recherche séquentielle dans une table devient 
long dès que le nombre d'éléments est important (une seconde 
pour 200 éléments en Basic interprété). 


Une façon de réduire le temps de recherche dans une table, 
pourvu qu'elle soit triée, consiste à procéder par dichotomie : 


- Le principe de la recherche dichotomique consiste à comparer 
l'élément cherché à celui du milieu de la table. Selon qu'il 
est plus grand ou plus petit, on sélecte la moitié de la 
table où il se trouve 


- En procédant de la même façon sur la moitié sélectée, on 
converge vite vers l'élément recherché 


= N nombres en ordre croissant ------- > 
! ! 
36 T7 scsssse 16 18 ..... 40 50 60 70 
! ! ! 
INF MIL SUP 
a —- Recherche dichotomique simple 


10 INPUT "Quel nombre cherchez vous? ";X 
20 ! 
100 INF=1:SUP=N 

! 


110 IF INF>SUP THEN PRINT "Ce nombre n'existe pas":GOTO 10 

115 MIL=INT(INF+SUP )/2) 

130 IF X=A(MIL) THEN PRINT "Position de:";X;MIL:GOTO 10 

140 IF X<A(MIL) THEN SUP=MIL-1:GOTO 110 ELSE INF=MIL+1:GOTO 110 


Dès que la variable SUP devient inférieure à INF, nous en 
concluons que l'élément cherché n'existe pas. 


Lorsque l'élément cherché n'existe pas, nous devons souvent 
l'insérer dans la table, et bien entendu, de façon à ce que 
la table soit toujours en ordre croissant. Au moment où nous 
détectons que l'élément cherché n'existe pas, la variable MIL 
indique soit la position d'insertion, soit cette position-l. 
Avant de quitter le sous-programme, il nous suffit, pour fournir 
la position d'insertion, de faire : 


1080 IF INF>SUP THEN R=2:ISER=MIL:IF NOM$>CLE$(ISER) THEN ISER=ISER+1:RETURN 
ELSE RETURN 


Autre difficulté : le même élément peut exister en plusieurs 
exemplaires. C'est par exemple le cas dans le programme étudié 
ou pour réduire la taille de la table des CLES,:seules les 
premières lettres ont été stockées : 
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LE BASIC ET SES FICHIERS 


SCLES() PT$() 


table NOM$ table IX4 7 

ABRAH 10 8 |DUPOND XXXXXXXXXX 
BALUT 9 D 9 |BALUT XXXXXXXXXX 
BALUT 12 10 ABRAHAM XXXXXXXXXX 
DUPON 8 DUPONT XXXXXXXXXX 
DUPON 11 BALUTIN XXXXXXXXXX 
<-5-> 


FICHIER PRINCIPAL 


- 11 convient de se positionner sur la première clé de la 
table CLES() pour ensuite explorer la séquence des clés 
égales. Or la recherche dichotomique positionne sur une 
clé quelconque 


- La façon la plus simple pour se positionner sur la première 
clé, consiste, au moment où on a retrouvé une clé, à compa- 
rer celle-ci à celle immédiatement inférieure. S'il y a 
égalité, nous considérons que la clé cherchée n'est pas 
trouvée et nous continuons la recherche. 


1110 IF NOM$=CLE$(MIL) THEN 
IF CLE$(MIL)=CLE$(MIL-1) THEN SUP=MIL+1:GOTO SUITE ELSE Q=1:RETURN 


Pour le programme INDD, la table d'index est sauvegardée dans 
les enregistrements de 1 à 7 du fichier principal. L'index 

doit être sauvegardé totalement à chaque ajout de clé puisque 
toute la table peut être modifiée par les décalages des clés. 
La régénération de l'index en cas d'incident sera faite ainsi 


1/ Constitution de CLES() et INDEX() par lecture du fichier 
2/ Tri de CLES() et INDEX() 
3/ Sauvegarde de ces tables 
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10 
20 
30 
40 
50 
70 
80 
90 
100 
110 
120 
130 
140 
150 
160 
170 
TI 
180 
190 
200 
210 
220 
230 
240 
250 
260 
270 
280 
290 
300 
310 
320 
330 
340 
350 
360 
370 
380 
390 
400 
410 
420 
430 
440 
450 
460 
470 
480 
490 
500 
510 
520 
530 
540 
550 
560 
570 
580 
590 
600 
610 
620 


LE BASIC ET SES FICHIERS 


INDD 25.12.80 


NBC : Nombre de cles dans la table d'index 


CLEAR(5000) 

DEFINT A-Z " NCL: Nombre de cles par enreg de l'index 

LGCL=5 : NCL=15 " Sur TRS80 NCL=(254/(5+2)) 

DIM SCLE$(NCL ),PT$(NCL) " SCLE$():PT$() Tables pour FIELD index 


OPEN "R",1,"IND" 
1? 
FIELD #1,10 AS NM$,8 AS PREN$,20 AS TEL$ 


FOR I=1 TO NCL:FIELD #1,(LGCL+2)#(1-1) AS D$,(LGCL) AS SCLE$(I),2 AS PT$(I):NEX 
" Pour FIELD index 
LU 


DIM CLE$(500),INDEX(500) 
' 


GET #1,1:IF ASC(SCLE$(1))=0 THEN GOSUB 870 


GOSUB 530 " Appel lecture index 
PRINT TAB(20) "Modes:":PRINT 


PRINT TAB(30) "C : Creation" 

PRINT 

PRINT:INPUT " Mode? (C,RI,FIN) ";M$ 
IF M$="C" THEN GOSUB 320 

IF M$="L" THEN GOSUB 1170 

IF M$="FIN" THEN CLOSE #1:STOP 

GOTO 260 


AJOUT D'UN NOM 


PRINT:INPUT "Nom ? ";NOM$ 

GOSUB 750:ON R GOTO 320,350 " Appel recherche cle 
RANG=LOF(1):GET #1,RANG * LOF(1)+1 sur TRS80 
LSET NM$=NOM$ 

INPUT "Prenom? ";X$:LSET PREN$=X$ 

INPUT "Telephone? ";X$:LSET TEL$=X$ 

PRINT :PRINT TAB(30):R$="":INPUT "OK? ";R$:IF R$><"O" GOTO 320 
PUT #1,RANG 

GOSUB 440 


IF NBC-=0 OR ISER>NBC THEN GOTO 480 " INSERTION D'UNE CLE 


FOR K=NBC TO ISER STEP-1:CLES$(K+1)=CLES$(K):INDEX(K+1)=INDEX(K):NEXT K 
' 


CLES$(ISER)=NOM$ : INDEX(ISER)=RANG : NBC=NBC+1 


GOSUB 920 " Appel sauvegarde index 
RETURN 
lzzzzs2222222222222222222222222222SS222S2SSSSSSSSSSSSSSSSZZSSSS==SSS2SSS2SES 
k LECTURE DE L'INDEX DISQUE DANS CLE$() et INDEX() 
NBC=0 " NBC:Nombre de cles 
FOR I=1 TO 7 

GET #1,1 


FOR J=1 TO NCL 
IF ASC(SCLE$(J))=0 GOTO 600 
NBC=NBC+1:CLE$ (NBC)=SCLES$ (J) : INDEX(NBC)=CVI(PT$(J)) 
NEXT J 
NEXT I 
RETURN 


! 
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LE BASIC ET SES FICHIERS 


' RECHERCHE D'UNE CLE 

! 

d Retour : R=1 : la cle existe / R=2 : la cle n'existe pas 
' 

1! 

L=LEN(NOM$) " L'operateur n'entre que les premieres lettres 
1! 

GOSUB 1050 " Appel recherche dicho 

ON R GOTO 810,790 

RETURN " Le NOM n'est pas trouve 

' 

GET #1,INDEX(ISER) " Une cle a ete trouvee dans CLE$() 
IF NOM$=LEFT$(NM$,L) THEN RANG=INDEX(I):R=1:RETURN 


IF NOM$<NM$ OR INDEX(ISER)=0 THEN R=2:RETURN 
ISER=ISER+1:GOTO 810 
loss seosormémiiesosmmmintosñssémmihamaiiosssdetésess= 
! 
PRINT :PRINT "INITIALISATION INDEX" :PRINT 
FOR I=1 TO 7:GET #1,1I:PUT #1,1I:NEXT I 
RETURN 
PRE RER EC ES SR RAR PE PI ESS SES SEE ES SECRET, 
' SAUVEGARDE de CLE$() et INDEX() dans enreg 1 a 7 
W=1 
FOR I=1 TO 7 
GET #1,1 
FOR J=1 TO NCL 
IF CLE$(W)="" THEN PUT #1,1:RETURN " Derniere cle? 
LSET SCLES$(J)=CLE$(W):LSET PT$(J)=MKIS$(INDEX(W) ) :W=W+1 
NEXT J 
PUT #1,1 
NEXT I 
VD sé en ei 2 202 2 de ec ne em een on ed de mie a mt sis ue mi ci A in sn ét à 6 8 me 
L RECHERCHE DICHOTOMIQUE 
" INF:borne inferieure/ SUP:superieure/ MI:milieu /ISER:position d'insertion 
: Retour: R=1 : cle trouvee / R=2 : cle non trouvee 
INF=1:SUP=NBC 
IF SUP<1 THEN R=2:ISER=1:RETURN 
LU 
IF INF>SUP THEN R=2:ISER=MI:IF NOM$>CLE$(ISER) THEN ISER=ISER+1:RETURN ELSE RE 
LU 
MIL=INT((INF+SUP)/2) 
IF NOM$=LEFT$(CLE$(MIL),L) OR CLE$(MIL)=LEFT$(NOM$,LGCL) THEN 
IF (NOM$=LEFT$(CLES$(MIL-1),L) OR CLE$(MIL-1)=LEFT$(NOM$,LGCL)) THEN 
SUP=MIL-1:GOTO 1080 ELSE R=1:ISER=MIL: RETURN 
LU 
IF NOMS$<CLE$(MIL) THEN SUP=MIL-1:GOTO 1080 ELSE INF=MIL+1:GOTO 1080 
' 
| SEE URCS, RER CEE CRE ER RE RE SE ER RTE 
' LISTE TRIEE(par l'index) 
PRINT 
FOR I=1 TO NBC 
GET #1,INDEX(I) 
PRINT NM$,PREN$,TEL$ 
NEXT I 
RETURN 
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10 ' dicho 

20 ! RECHERCHE DICHOTOMIQUE ET INSERTION 

30 ‘ 

40 DIM A(100) * 100 elements maxi pour table A() 
50 NBE=0 " Nb d'elements de A() 

60 ! . 


70 INPUT ‘Quel element cherchez vous? ";X 
80 GOSUB 260:ON R GOTO 100,130 
' 


90 

100 PRINT "Element place en:";MIL:GOTO 70 
110 ! 

120 "--—--- Insertion 


130 PRINT "Insertion en:";ISERT 
140 IF ISERT>NBE THEN 190 


150 FOR I=NBE TO ISERT STEP-1 ! Decalages 
160 A(I+1)=A(I) 

170 NEXT I 

180 ! 

190 ACISERT)=X " Insertion 


200 NBE=NBE+1 
210 PRINT:FOR 1=1 TO NBE:PRINT I,A(I):NEXT I 


220 GOTO 70 

230 _- Recherche dichotomique 

240 ! Retour: R=1 Element trouve R=2 Element non trouve 

250 ‘ ISERT: Position d'insertion 

260 INF=1:SUP=NBE 

270 IF NBE<1 THEN ISERT=1:R=2:RETURN " Y'a rien dans la table 
280 ! 


290 IF INF>SUP THEN R=2:ISERT=MIL:IF X>A(ISERT) THEN ISERT=ISERT+1:RETURN ELSE RETU 
RN 

300 MIL=INT((INF+SUP)/2) 

310 IF X=A(MIL) THEN R=1:RETURN " Element trouve 

320 IF X>A(MIL) THEN INF=MIL+1:GOTO 290 ELSE SUP=MIL-1:GOTO 290 

330 


340 RUN 

350 Quel element cherchez vous? 6 
360 Insertion en: 1 

370 


L 
’ 
1! 
LU 
380 ' Quel Element cherchez vous? 10 
L 
LU 
' 
LU 


390 Insertion en: 2 

400 

410 Quel element cherchez vous? 7 
420 Insertion en: 2 
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ACCES INDEXE ET ALLOCATION DYNAMIQUE 


Nous connaissons le problème de la récupération des enregis- 
trements supprimés dans un fichier. Une réorganisation de celui- 
ci la permet, mais il est plus élégant de les récupérer dyna- 
miquement grâce à des bits-map ou des chaînages. 


Dans le cas d'un accès indexé, il suffit de repérer les 
enregistrements inutilisés par un caractère quelconque ('x' 
par exemple) dans la table d'index. C'est la méthode que nous 
avons utilisée dans le programme EDIR. 


FICHIER 


= 
[ripon [xx 


ENREGISTREMENTS 

INUTILi SES 
Si la table a été rangée en ordre croissant, dans le but d'y 
effectuer une recherche dichotomique, les pointeurs vers les 
enregistrements libres seront placés en fin de table afin de 
faciliter la recherche dichotomique. 


Nomg() IX) FicHiER PRINCIPAL 


ENREGISTREMENTS LidRES 


Les pointeurs NBC et TC n'ont pas à être sauvegardés sur 
disque. Leurs valeurs seront calculées au moment où la table 
NOMS () (sauvegardée sur disque) est transférée en mémoire 
centrale en début de session. 
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EDITEUR DE FICHIER RANDOM 


Ce programme permet de gérer des fichiers Random sans qu'il 
soit nécessaire d'écrire des programmes. L'opérateur décrit les 
différentes zones de chaque enregistrement (NOM, LONGUEUR, TYPE) 
Ces caractéristiques sont stockées dans l'enregistrement numéro 
1 du fichier. 


Une saisie d'écran caractère par caractère est générée en 
fonction de ces zones. 


Nom TYPE LONÇQUEUR 


# DESCRIPTEUR De Zones (ENREGISTREMENT N°41) 


D'autres fonctions sont également assurées : 


- tri selon une zone quelconque 
- tri multicritères 
- édition automatique 
- accès indexé sur la première zone du fichier 
FichieR PRINCIPAL FICHIER INDEX 


puront 4[cuaruielfl | 


N&ÿ0) TZ) LZ0 LS() P4() 


:] E F1 


NOM Je Zoe TYPE LONGUEUR LONGUEUR POSITION 
SymBoLiQué GONE ZONE SAÏSIE DANS L'ENREGISTREMENT 


Exemple : Création d'un fichier avec trois zones (NOM, PRENOM, 
TELEPHONE) 


Nom de zone? NOM 
Type(C, SN)? C 
Longueur ? 15 


Nom de zone? PRENOM 
Type(C,S,N)? oc 
Longueur 7? 12 


Nom de zone?  TPH 


Nom de zone? <ENTER> 


CLS:PRINT "EDIR 9.1.81 
CLEAR(4000):DEFINT I-S 
LL 


! 
! 
0 
! 
0 
‘ 
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EDITEUR DE FICHIER RANDOM " 


PERMET DE GERER UN FICHIER "RANDOM! SANS ECRIXE DE PROGRAMME 


«GENERATION D'UNE SAISIE D'ECRAN 
*EDITIONS 
«TRI MULTICRITERES 


ACCES INDEXE 


DIM NWS(15),PWS(15),LWS(15),TW$(15),LZ(15),1Z(15) 


DIM PZ(15),T2$(15),LS(15),NZ$(15),Z$(15),ZN$(15),10(15),Y(15),X(15) 


DIM R$(15),CLES(300),IX4(300) 


' 


" Nw$ 
1" TWS 
" LWS 
" PWS 


CO) : NZ$O) : 
OO: TZ OO: 
O : LZ O) 

O : PZ O : 


PRINT:PRINT:PRINT 
IF NFS><"" THEN OPEN "R",1,NF$ ELSE GOTO 220 


OPEN "R",#2,"I"+NFS 
LCL=8:NCL=INT(254/(LCL+2)) 


NZ : Nonbre de zones par enregistrement 


Nons des zones symboliques 
Types des zones (C,I,S,N) 
Longueur des zones fichier 
Position des zones dans l'enregistrement 


Nom du fichier (XX:0) ";:LINE INPUT NFS 


" Ouverture fichier index 
" LCL:Longueur cles 


DIM CTERE$S(NCL),PTS(NCL) 
FOR I=1 TO NCL: 


FIELD #2,(LCL+2)*(1-1) AS DS$S,(LGL) AS CITERES(I),2 AS PTS(I):NEXT L 
" Appel lecture fichier index 
FIELD #1,195 AS D$,1 AS J$,1 AS MS,1 AS AS:GET #1,1 


GOSUB 


2230 


DTS=STRS(ASC(J$S))+STRS(ASC(MS))+STRS(ASC(AS)) 
PRINT :PRINT "DATE: ";DTS 


X=0:INPUT "JOUR 
ELSE GOTO 330 
X=0: INPUT 
X=0:INPUT "AN 


PUT #1 


FL 


"MOIS 


"3X:IF X<32 AND X>0 THEN LSET JS=CHRS(X) 


"3X:IF X><O THEN LSET MS=CHRS(X) ELSE GITO 340 


";X:IF X<90 AND X>0 THEN LSET AS=CHRS(X) 


DT$S=STRS(ASC(J$S))+STRS(ASC(MS))+STRS(ASC(AS)) " Date fichier 
GOSUB 690:ON Q GOTO 400,390 ‘ Lecture descripteur de zones 
GOSUB 890:GOT9 380 


IF NZ<1 THEN PRINT :PRINT "Declarez 2 zones au noins":PRINT:COTO 390 
FOR I=1 TO NZ 


" Introduction descripteur de zones 


Field pour fichier principal 


FIELD #1,PZ(1)-1 AS DS$,LZ(I) AS ZN$(I):NEXT I 
PRINT:INPUT "APPUYER SUR <ENTER> "3RS$ 
CLS:PRINT “GESTION 
a MENU 


PRINT 
PRINT 
PRINT 
PRINT 
PRINT 
PRINT 
PRINT 
PRINT 
IF M$= 


GOTO #4 


QE EEE EURE EEE EE EEE EEE EEE POTTER EEE 


TAB(20) 
TAB(20) 
TAB(20) 
TAB(20) 
TAB(20) 
TAB(20) 
TAB(20) 


"ME 
°LF 


"LFT : 


"MC 
"SU 
"CRI 


DU FICHIER: ";3NF$:PRINT “FONCTIONS POSSIBLES. ." 


"FIN : 


: AJOUT ET MODIF PAR NO ENREGISTREMENT" 


LISTE DU FICHIER NON TRIEE" 
LISTE DU FICHIER TRI£" 

AJOUT ET MODIF PAR CLE" 
SUPPRESSION PAR CLE" 

CREATION INDEX (SI INCIDENT)" 
FIN LE SESSION (OBLIGATOIRE)" 


:INPUT "MODE CHOISI (ME,MC,SU,LF,LFT,DZ,FIN,..)"3;MS 


"ME" THEN GOSUB 2170 

IF M$="LF" TIEN GOSUB 1340 

IF M$="LFI" THEN GOSUB 2630 

IF M$="FIN" THEN GOSUB 4060:CLOSE #1,#2:CMD "S"SYSTEM 
IF M$="CRI" THEN GOSUB 3890 

IF M$="MC" THEN GOSUB 4180 

IF M$="SU" THEN GOSUB 2460 

IF M$="DZ" THEN GOSUB 890 


40 


130 


" Field date 
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670 ! AFFICHAGE DU DESCRIPTEUR DE ZONES 

680 

690 GOSUB 860:GET #1,1:IF ASC(NWS$(1))=0 THEN Q=2:RETURN 

700 Z=0:PRINT 

710 CLS:PRINT "RECAPITULATIF DE LA DESCRIPTION DES ZONES ":PRINT 

720 PRINT ‘NOM POSITION LONGUEUR TYPE" :PRINT 

730 FOR I=1 TO 15 

740 IF ASC(NWS(I))=0 THEN NZ=I-1:GOT0 830 

750  NZS(I)=NWS$S(I):LZ(I)=ASC(LW$(I)):LS(I)=LZ(1):PZ(I)=ASC(PWS(I)): 
TZ$(I)=TW$(1) 

760 TZ(I)=1 

770 IF TW$(1)="S" THEN TZ(I)=2:LS(1)=7 ELSE TZ(I)=1 ‘ LS() LG SAISIE 

780 IF TW$(I)="N" THEN TZ(I)=4:LS(1)=3 

790 LF TWS(I)="E" THEN TZ(1)=3:LS(1)=5 

800 PRINT NZ$(I1),PZ(I),ASC(LWS(I)),TZS(I) 

810 NEXT I 

820 NZ=1-1 

830 Q=1:RETURN 

840 ‘== 

850 FIELD DU DESCRIPTEUR DE ZONE 

860 FOR Q=1 TO 15:FIELD #1,(Q-1)*10 AS D$,7 AS NNS(Q),1 AS PWS(Q), 

1 AS LW$(Q),1 AS TW$(Q):NEXT Q:RETURN 

870 1" - 

880 ! INTRODUCTION DE LA DEFINITION DES ZONES 

890 GET #1,LOF(1)+1:PRINT:PRINT “DEFINISSEZ LES ZONES ! " 

900 PRINT:PRINT "NOM DE ZONE : 7 CARACTERES MAXI([ POUR ANNULER)":PRINT 


910 PRINT "TYPE DE LA ZONE: ENTRER C POUR CHAINES DE CAKACT" 
920 PRINT" ENTRER N POUR NUMERIQUE <256" 

930 PRINT" ENTRER E POUR ENTIERS (<32000) 
940 PRINT" ENTRER S POUR SIMPLE PRECISION" 


950 PRINT :PZ=1 
960 FOR I=1 TO 15 
970  PRINT:PRINT "NOM DE ZONE ‘;l; 
980 X$="":INPUT KS:IF X$="" COTO 1090 
990 LF X$="{" AND IL THEN I=I-1:X$="":GOTO 970 
1000  LSET NW$(I)=X$ 
1010  LSET PW$(I)=CHRS(PZ) 
1020 X$="":INPUT'TYPE (C,N,E,S) "3XS:LSET TWS(I)=XS 
1030 IF X$="5" THEN X$="4":GOTO 1070 
1040 IF X$="N" THEN X$="1":GOTO 1070 
1050 IF X$="E" THEN XS$="2":COTO 1070 
1060  X$="":INPUT "LONGUEUR ZONE "3;XS$:IF VAL(X$)=0 GOTO 1960 
1070  LSET LWS$(I)=CHRS(VAL(XS$)):PZ=PZ+VAL(XS) 
1080 NEXT I 
1090 PUT #1,1 
1100 CLOSE #2:KILL "I"+NFS:OPEN "R",#2,"I"4NFS 
1110 NBC=0:FOR I=1 TO 300:CLES$(I)="":IXX(I)=0:NEXT I 
1120 RETURN 
LU 


1130 

1140 M'=mmzz2222222222222222222222222222222222222222=2222222222222222222 
1150 SAUVEGARDE DE LA PARTIE D'INDEX MODIFIEE 

1160 DB=INT((NI-1)/NCL) * Nl:no element de l'index modifie 


1170 K=DB*NCL+1 

1180 GET #2,08+1 

1190 FOR J=1 TO CL 

1200 IF CLES(K)="" THEN PUT #2,DB+1:RETURN 

1210 LSET CTERES(J)=CLES(K):LSET PTS$S(J)=MKIS(IXZ2(K)):K=K+1 
1220 NEXT J 

1230 PUT #2,0B+1 

1240 RETURN 

1250 
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1320 '===m2m=22222222222222222=222222==222=2-22=222=22222222222=222=2222 
1330 EDITIONS FICHIER 
1340 PRINT:PRI!IT:SOSUB 1990:PAIHT " Appel quelles zones? 
1350 INPUT "COMMENTAIRE "3;XXS 
1360 E=l:PRINT:R$="": INPUT “EDITION LIHPRIMANTE (O/N) ";xS: 
IF K$="O0" THEN E=2 


1370 GOSUB 2530 " Appel quelles zones? 
1380 ON E GOSUB 1390,1500:GOT0 1419 

1385 ‘---------.….. Ses Edition titre ecran 

1390 PRINT:PRINT "LISTE DU FICHIER ";VFS;" iNFS: PRINT: PRINT 
1419 PRINT " ° 


1420 FOR W=1 TO 15 
1430 IF Z$(w)="" GOTO 1470 


1440 PRINT NZ$S(ID(N)); " 1D(): No de zone 
1450 FOR K=7 TO LZ(ID(W)):PRINT " ";:NEXT K 
1460 NEXT W 


1470 PRINT:PRINT 
1480 RETURN 
L 


1490 ‘== Edition titre imprimante 
1500 LPRINT:LPRINT LISTE DU FICHIER: ";3"""3;3NF$;"""; 
“ "3DT$;" "3XXS$ 
1510 LPRINT:LPRINT 
1520 LPRINT " = 
1530 FOR W=1 TO 15 " Impression des noms de zones 


1540 IF Z$(W)="" GOTO 1580 
1550 LPRINT NZS(ID(wW)); 
1560 FOR K=7 TO LZ(ID(W)):LPRINT “ “;:NEXT K 
1570 NEXT W 
1580 LPRINT:LPRINT 
1590 RETURN 
1600 ‘---------------- Lecture du fichier 
1610 FOR C=L1 TO L2 
1630 GET #1,C:IF ASC(ZS(1))=0 GOTO 1650 
1640 ON E GOSUB 1840,1710 
1650 NEXT C 
1660 IF E=2 THEN LPRINT CHRS(12) 
1670 PRINT:INPUT"FAIRE <ENTER> POUR CONTINUER"; &KS$ 
1680 RETURN 
1690 ------ Edition imprimante 
1710 LPRINT USING “#{## ";C; 
1720 FOR W=1 TO 15 
1730 IF ZS$S(W)="" GOTO 1800 
1740 ON TZ(ID(W)) GOTO 1780,1760,1750,1770 
1750 LPRINI USING “ ##HHHH# "; CVI(ZS(W)); :LPRINT “ “;:GOTO 1790 
1760 LPRINT USING “’#H#F{HFH" ; CUS(ZS(W)); : LPRINT “ 
1770 LPRINT USING “ ##HiHf  “;ASC(ZS$S(W)); :LPRINT " "; 
1780 IF LEN(ZS(W))>=7 THEN LPRINT ZS(W);" "; 
ÉLSE LPRINT USING "4 2";ZS(W); 
1790 NEXT W 
1800 LPRINT 
1810 RETURN 
1820 
1840 PRINT USING "##f# ";C; 
1850 FOR W=1 TO 15 
1860 IF Z$S(W)="" THEN GOTO 1930 
1870 ON TZ(ID(W)) GOTO 1910,1890,1880,1900 
1880 PRINT USING “ ##H{Hif#f ";CVI(ZS(W)); : PRINT " ";:GOTO 1920 
1890 PRINT USING “#HHHFHHH" ; CVS(ZS(W)); :PRINT " ";:COTO 1920 
1900 PRINT USING " 3##4f ";ASC(Z$S(W)); : PRINT “ ";:COTO 1920 
1910 IF LEN(ZS(W))>=7 THEN PRINT Z$(W);" “; 
ELSE PRINT USING "4 2"3;2ZS(W); 
1920 NEXT W 
1930 PRINT:RETURN 


Edition ecran 
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1980 
1990 
2900 
2919 
2040 
2050 
2070 
2090 
2190 
2119 
2120 
21390 
2135 
2140 
2160 
2170 


2130 
2190 
2290 
2219 
2220 
22390 
2249 
2250 
2260 
2270 
2289 
2290 
2399 
2310 
2320 
2330 
2340 
2350 
2369 
2370 
2380 
2390 
2409 


2410 
2420 
2439 
2440 
2450 
2460 
2470 
2480 
2490 


2500 


2510 
2520 
2530 
2540 
2550 
2560 
2570 
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lsnsosséensersisotssnucosesietiéemesesssssodisssésscssés sp 
: QUELLES ZONES A EDITER? 
GISUB 690:PRINT 
Z=) " ID():No de zones a editer 
FOR I=l TO 15:Z$(1)="":NEXT IL 
PRINT:PRINT "ZONE: "; 
PRINT TAS(12) :FOR I=l TO 6 :PRINT NZ$(I1);" ";:NEXT [L:PRINT 
PRINT CAB(12):FOR I=7 TO 1S:PRINT NZS(1);" ";3:NEXT L:PRINT:PRINT 
XS="": INPUT "ZONE A LMPRIMER: "5XS:IF X$="" TIEN RETURN 
FOR Il TO 15 

IF LEFTS(NZS(T),LEN(KS))=X$S THEN Z=Z+1:1D(Z)=1:GOT0 2140 
NEXT [ 
GOTO 2990 
L 
FIELD #1,PZ(I)-1 AS D$,LZ(I) AS Z$(Z):GOTD 2090 
lmz-2222222:2222222222222222222222222=222222222=2==:2222222222=22= 
PRINT: NO=9: PRINT : PRINT "FIN FICIHIER="; LOF(1);: 
IAPUT “ NO ENREGISTREMENT ‘; NO: 
If H)9<2 Ti RETURN 
GET #L,NO: PRINT 
GOSUB 3250:PUT #1,N0:GOTO 2170 
lmz=-z-22222222222:222222222222222222=2=22=2-2=222:22=222=222=22222=222=2=-2222 
, LECTURE DE L'INDEX 
N3C=9 
FOR I=l TO 15 

GET #2,1 

FOR J=l TO NCL 

IF ASC(CTERES(J))=0 GOTO 2300 
NBC=NBC+1 : CLES(NBC)=CTERES(J):IXZ(NBC)=CVI(PTS(J)) 

NEXT J 
NEXT I 
RETURN 
lazzz22222222=22222=222=22=2==2-=2=2=2222=22========222=======22=222=2== 
ECART=NB:PRINT:PRINT "JE TRIE POUR VOUS":PRINT " TRI 
LU 
ECART=INT(ECART/2):1IF ECART<L THEN RETURN 


J=L1:K=NB-ECART 

I=J 

L=I+ECART 

IF CLES(I)<CLES(L) GOTO 2430 

X$=CLES(L) : CLE$S(L)=CLES$S(I):CLES(I)=XS: 
X=IX2(L):IXZ2(L)=IXX(1):1IX2(1)=X 

I=I-LCART:IF I<1 GOTO 2430 ELSE GOTO 2380 

LU 


J=J+1:IF J>K GOTO 2350 ELSE GOT9O 2370 


lR===2222222222222D22222SSIS=STI2ISSISSSSSSSSLSSSS SE SSSSSSSS2 22 


L SUPPRESSION(* POUR ENREG SUPPRIME) 
PRINT:X$="":INPUT "CLE ";XS:IF X$="" TIIEN RETURN 

GOSUB 4340:ON Q GOTO 2499,2489 " Appel recherche cle 
PRINT :PRINT "N'existe pas “:PRINT:GOTO 2460 

PRINT:PRINT ZNS$S(1);:R$="":INPUT “Annule OK (0) “;RS: 

IF R$S><"O" GOTO 2460 

CLES(PS)="*":GET #1,LOF(1)+1:LSET ZN$S(1)="*": 

PUT #1,IXZ4(PS):NI=PS:GOSUB 1160 " Appel sauvegarde cle$() 
GOTO 2460 
ln222222222222222222222S2S2222S2SAMMEUSESSLSSESSSSSSUESSMNSSMSSSSESSSS 
INPUT"NO D'ENREGISTREMENT DE DEBUT ";L1$ ‘ Quelles bornes? 
IF L1$="" THEN Ll=2 ELSE L1=VAL(L1$)+1 

INPUT"NO D'ENREGISTREMENT DE FIN ";L2$ 

IF L2$="" THEN L2=LOF(1) ELSE L2=VAL(L2$)+1 

RETURN 
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2580 
2600 
2610 
2620 
2630 
2640 
2650 
2660 
2670 
2680 
2690 
2790 
2710 
2720 
2730 


2740 
2750 
2760 
2770 
2730 
2790 
2800 
2810 
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LEE EEE PP PP PP PP PPPPTEPPETE LEE) 
L 

LU 

! TRI MULTICRITERES 

NB=0:GOSUB 690 

GOSUB 4060 " Sauvegarde de la table d'index 

FOR I=l TO 4:T(I)=0:NEXT I:PRINT 


X$="": INPUT "PREMIER CRITERE DE TRI :";3XS:IF X$="" THEN RETURN 
FOR I=1 TO 15 
IF LEFTS(NZS(I),LEN(XS$S))=X$ TIIEN T(1)=TZ(I):GOTO 2710 
NEXT I 
GOTO 2660 
FIELD #1,PZ(I)-1 AS DS,LZ(I) AS CRIT$(1) 
FOR K=2 TO 3 


PRINT:XS="":PRINI K;"CRITÈRE DE TRI : “;:INPUT X$: 
IF XS="" GOTO 2800 
FOR L=l TO 15 
IF LEFTS(NZ$S(L),LEN(XS))=X$ T!IEN T(K)=TZ(L):G0TO 2780 
NEXT L 
GOTO 2730 
FIELD #1,PZ(L)-1 AS D$,LZ(L) AS CRIT$(K) 
NEXT K 
GOSUB 2000 " Appel quelles zones? 
E=L:PRINT:R$="":INPUT "EDITION IMPRIMANTE (O/N) “;RS: 


IF R$="O" THEN E=2:INPUT"COMMENTAIRE ";XXS 


2820 


2840 
2850 
2860 
2370 


2880 


2890 


2900 


29190 
2920 
2930 


2940 


2950 


2960 


2970 
2980 
2990 
3000 
3010 
3020 
3040 
3050 
3060 
3070 
3080 
3090 
3100 
3110 
3120 


GOSUB 2530:PRINT " Appel calcul bornes L1 ET L2 
Fées Lecture du fichier 
FOR I=L1 TO L2 
GET #1,1 
ON T(1) GOTO 2870,2880,2890,2900 
IF ASC(CRIT$(1))=0 GOTO 3000 
ELSE : NB=NB+1:CLES(NB)=CRIT$(1):SOTO 2910 
IF CVS(CRIT$(1))=0 GOTO 3000 ELSENB=NB+1 : 
CLES(NB)=RIGUTS(" "#STR$S(CVS(CRITS(1))),7):GOTO 2910 
IF CVI(CRITS$(1))=0 GOTO 3000 ELSENB=NB+1 : 
CLES(NB)=RIGHTS(" "+STRS(CVI(CRITS(1))),7):GOTO 2910 
IF ASC(CRITS$(1))=0 GOTO 3000 ELSE 
NB=NB+1 : CLES(NB)=RIGUTS(" “"#STRS(ASC(CRITS(1))),5):GOTO 2910 
FOR K=2 TO 3 
IF T(K)><O THEN ON T(K) GOTO 2930,2940,2950,2960 ELSE GOTO 2980 
IF ASC(CRITS(K))=0 THEN GOTO 2980 
ELSE CLES(NB)=CLES(NB)+CRITS(K):COTO 2970 
IF CVS(CRITS(K))=0 COTO 2980 
ELSE CLES(NB)=CLES(NB)+RICHTS(STR$S(CVS(CRITS(K))),7):GOTO 2970 
IF CVI(CRIT$(K))=0 GOTO 2980 ELSE CLES(NB)= 
CLES(NB)+RIGHTS( * "+STR$S(CVI(CRIT$S(K))),7):GOTO 2970 
IF ASC(CRIT$(K))=0 GOTO 2980 ELSE 
CLES(NB)=CLES(NB)+RIGUTS(" “"#STRS(ASC(CRITS(K))),5):GOTO 2970 
NEXT K 
IXX(NB)=I 
PRINT CLES(NB) 
NEXT I 
GOSUB 2330 * Appel TRI 
fmmmmmmmmsmcmcs—— Editions 
ON E GOSUB 1390,1500 
FOR I=1 TO NB 
GET #1,1X%(1) 
C=IX%(I):ON E GOSUB 1840,1710 
NEXT LI 
IF E=2 THEN LPRINT CHRS(12) 


PRINT :INPUT "FAIRE <ENTER> POUR CONTINUER" ;KKS 
GOSUB 2230 " Lecture DE l'index 
RETURN 
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3190 
3200 
3220 
3230 
3240 
3250 
3260 
3270 
3290 
3300 
3310 
3320 
3330 
3340 
3350 


3360 
3370 
3380 
3390 
3400 
3410 
3420 
3430 
3440 
3450 
3460 
3470 
3480 
3490 
3500 
3510 
3520 
3530 
3540 


LE BASIC ET SES FICHIERS 


TABLES UTILISEES : NZ$() : NOMS DES ZONES 
LS () : LONGUEURS DES ZONES 


' 

' 

' 

! SAISIE ECRAN / Les coordonnees d'affichage sont calculees 

L 

FOR I=l TO NZ:TR$S(I)="":NEXT I 

CLS:GOSUB 3750 

PRINT@900,"ENREG:";NO:PRINT @924," [ POUR ZONES ARRIERES" 

P=1 

rates Saisie de N zones 

SET(35*2,P*3+1):GOSUB 3460 " Appel saisie ligne 
RESET(35*2,P*x3+1) " Extinction curseur ligne 

Où & GOTO 3370,3400,3340 " R=1:0K /R=2:RC /R=3:on remonte 

' 

IF P>1 THEN ON TZ(P) GOSUB 3600,3610,3610,3610:P=P-1:GOT0 3310 
ELSE 3310 


' 

ON TZ(P) GOSUB 3650,3670,3660,3680 * Rangement de LIGNES 
TRS(P)=LIGNES 

' 

IF ASC(ZNS(P))=0 TiEN IF TZ(P)=1 THEN LSET ZNS$S(P)="." 


PRINT @X,""; 

ON TZ(P) GOSUB 3600,3610,3619,3610 " Reaffichage zone 
IF P=>NZ THEN : RETURN 

P=P+1:GOTO 3310 


Lors Saisie d'une ligne 

LIGNES="" 

X=P*64+0+36:IF TZNE(P)=1 THEN AC$="." ELSE ACS$S="-" 

PRINT €x,""; 

: 

C$S=INKEYS:IF C$="" THEN 3500 * Attente d'un caractere 
C=ASC(CS): L=LEN(LIGNES) 


IF C=13 THEN IF LIGNES<>"" THEN R=1:RETURN ELSE R=2:RETURN 
IF C=91 THEN R=3:RETURN 
IF C=8 THEN IF L»>0 THEN PRINT CHR$S(8);ACS;: 


PRINT 9X+L-1,"";:LIGNES=LEFTS(LIGNES ,L-1):GOTO 3500 


3550 
3560 
3570 
3580 
3590 
3600 
3610 
3620 
3630 
3640 
3650 
3660 
3670 
3680 
3690 
3700 
3710 
3720 
3730 
3740 
3750 
3760 
3770 
3780 
3790 
3800 
3810 


ON TZNE(P) GOSUB 3620,3630,3630,3630:0N R GOTO 3560,3500 
PRINT C$; 
LIGNES=LIGNES+CS:IF L+1=>LS(P) THEN R=1:RETURN 


PRINT TR$(P);STRINGS(LS(P)-LEN(TRS(P)),".")3;:RETURN 

PRINT TR$(P); STRINGS(LS(P)-LEN(TRS(P)),"-"); : RETURN 

IF C<32 TilEN R=2:RETURN ELSE R=1:RETURN 

IF C >47 AND C<58 OR C=46 THEN R=1:RETURN ELSE R=2: RETURN 
' 


LSET ZN$S(P)=LIGNES : RETURN 

LSET ZN$S(P)=MKIS(VAL(LIGNES )) : RETURN 
LSET ZNS(P)=MKSS(VAL(LIGNES)) : RETURN 
LSET ZNS(P)=CHRS(VAL(LIGNES)) : RETURN 
' 


PRINT ZN$S(P);:RETURN * Affichage ancienne valeur 
PRINT CVS(ZNS(P)); : RETURN 
PRINT CVI(ZNS(P));:RETURN 


= Affichage grille de saisie 
FOR P=l TO NZ 


X=P*64:PRINT @X,NZS(P);TAB(7) ":"; 
PRINT @X+10,"";:0N TZ(P) GOSUB 3700,3710,3720,3730 
PRINT @X+36,""; 
ON TZ(P) GOSUB 3600,3610,3610,3619 
NEXT P 
RETURN 
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3870 
3880 
3890 
3900 
3919 
3920 
3930 
3940 
3950 
3960 
3979 
3980 
3990 
4000 
4010 
4020 
4030 
4040 
4060 
4070 
4080 
4090 
4100 
4110 
4120 
4130 
4140 
4150 
4160 
4170 
4180 
4190 
4200 
4210 
4220 
4230 
4240 
4250 


4260 
4270 
4280 
4290 
4300 
4310 
4320 
4330 
4340 
4350 
4360 
4370 
4380 
4390 
4400 
4410 
4420 
4430 
4440 


LE BASIC ET SES FICHIERS 


fm==222=2=222=2=22=22222==22222==222222222222222222=222222222232223 


, CREATION INDEX ZONL 1 (si incident) 
CLOSE #2:KILL "I"#+NFS:OPEN "R",2,"I"#+NFS 

FOR I=l TO 300:CLES(I)="":NEXT L:PRINT: PRINT 

L 

L} 


NBC=0 " NBC:nb de cles 
L 


FOR I=2 TO LOF(1) 


GET #1,1 

IF ASC(ZNS(1))=0 TAEN LSET ZNS(1)="*" " £nrey vide? 

PRINT L,ZN$(1) 

NBC=NBC+1 : CLES(NBC)=ZNS(1):IX2(NBC)=I 
NEXT IL 
GOSUB 4060 " Appel sauvegarde de cle$() 
RETURN 
ne Sauvegarde de cleS$() et ixZ() 
W=1 
FOR I=1 TO 15 

GET #2,1 

FOR J=1 TO NCL " NCL=INT(254/(8+2)) 

IF WDNBC THEN PUT #2,1:RETURN 
LSET CTERES(J)=CLES(W):LSET PTS(J)=MKIS(IXZ(W)):W=4+1 

NEXT J 
PUT #2,1 
NEXT !L 
RETURN 
lz=ssasassassmms=2=222=2=22=222=2=2=222=22=2=2=22=2==2==-==2==2=2=22=2=2==2=22=2=2=2=- 
à ACCÈS PAR CLE 
PRINT:PRINT:X$="":INPUT "CLE ";XS:IF X$="" THEN RETURX 


GOSUB 4340:ON Q GOTO 4200,4230 
PRINT:NO=RANG:GOSUB 3250:PUT #1,RANG " Q=l:Cle trouvee 
GOTO 4180 
Rss Nouvelle cle 
PRINT:R$="":INPUT "NOUVELLE CLE (0) ";R$S:IF RS><"O" T'IEN 4180 
FOR L=1 TO 300 
IF CLES(L)><"" THEN IF ASC(CLE$(L))=42 THEN PS=L: 
RANG=IXZX(L):GET #1,RANG:NO=PRANG: 
LSET ZNS(1)=X$:GOSUB 3250:PUT #1,RANG: 
CLES$(PS)=ZN$(1):NI=PS:GOSUB 1160:GOT0 4180 
IF CLE$(L)="" GOTO 4280 
NEXT L 
RANG=LOF(1)+1:PRINT:GET #1,RANG:NO=RANG:LSET ZNS(1)=X$:GOSUB 3250 
PUT #1,RANG 
NBC=NBC+1 : CLES(NBC)=ZNS(1) : IX2(NBC)=RANG: NI=NBC:GOSUB 1160 


EEE Recherche cle 


W=1:L=LEN(XS) " Q=1:LA CLE EXISTE /9=2: N'EXISTÉ PAS 
FOR I=W TO 300 

IF CLE$S(I1)="" THEN Q=2:RETURN 

IF X$S=LEFT$S(CLES(I),L) OR CLES(I)=LEFTS(X$S,LCL) GOTO 4410 
NEXT I 
PRINT "INDEX PLEIN" :STOP 


L 

GET #1,IX4(1) 

IF XS=LEFTS(ZNS(1),L) THEN PS=I:RANG=IXX(1):Q=1: RETURN 
W=I+1:GOTO 4350 


PL PR EEE EEE EE PUR PORTE 
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LE BASIC ET SES FICHIERS 


ANNEXE I 


DIFFERENCES ENTRE BASICS TRS-80 ET MICROSOFT 5. 


MICROSOFT 5. 


2 lettres significatives 


PRINT _RA__<>__ PRINT _RANG 


40 lettres 
significatives 


Séparateurs 


INPUT "Message";x 


Il n'y a pas d'espaces 
séparateurs 

Corollaire : Les noms de 
variables ne doivent pas 
comporter de MOT-CLE du 
BASIC 


Si l'opérateur appuie sur 
<ENTER?, X conserve son 
ancienne valeur. 


Un point d'interrogation 
est imprimé après le 
message. 


Les espaces 
séparateurs sont 
obligatoires 


Une variable prend 
la valeur nulle si 
l'opérateur appuie 
sur RC 


N'existe pas 
directement 


Graphique 


SET(X,Y) allume le point 
X,Y 

RESET(X,Y) éteint le 
point X,Y 

POINT(X,Y) teste si le 
point X,Y est allumé 


N'existe pas en 
standard 


LOF(n° fichier) fournit 
nombre d'enregistrements 
d'un fichier 


LOF(n° fichier) 
fournit le nombre 
d'enregistrements 
MODULO 128 


Echange les 
valeurs de X et Y 


N'existe pas : faire : 
A=X:X=Y:Y=A 
N'existe pas : faire : 


FOR I=1 TO N:A(I)=0: 
NEXT I 


Ne fonctionne 
qu'en interprété 
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LE BASIC ET SES FICHIERS 


ANNEXE III 


COMMANDES ESSENTIELLES DU D.O.S. TRS-80 


copr 


1/ 


2/ 


3/ 


4/ 


5/ 


6/ 


Permet de copier des fichiers : 
COPY :0 TO :1 05/30/81 


copie tous les fichiers de la disquette du lecteur 0 sur 
la disquette du lecteur 1 
La date est spécifiée par MM/JJ/AA 


La copie est précédée d'un formattage. 

La disquette destination peut donc être vierge 

COPY :0 TO :0 05/30/81 

permet la duplication d'une disquette avec un seul lecteur 
Les disquettes 'source' et 'destination' doivent être 
montées alternativement. 

COPY XX:0 TO XX:1 

copie le fichier 'XX' de la disquette du lecteur 0 sur la 
disquette du lecteur 1 

COPY XX:0 TO :1 

forme abrégée 


COPY XX:1 TO :0 
Seule la disquette destination contient le D.0.S. 


COPY :0 XX TO XX 


Avec un seul lecteur. 

Si la disquette source ne contient pas le système, placer 
une disquette système, frapper la commande et attendre les 
instructions 


DIR 


DIR 

fournit la liste des fichiers sur la disquette du lecteur 0 
DIR :1 

fournit la liste des fichiers sur la disquette du lecteur 1 
DIR :0(S) 


fournit la liste des fichiers systèmes et des fichiers qui 
ne sont pas invisibles 


DIR :0(I) 


fournit les fichiers invisibles plus ceux n'appartenant pas 
au système 
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DIR :0(A) 
fournit l'espace occupé par chaque fichier 


DIR :0(S,I,A) 
combine les effets de S,I,A 


FREE 
indique la place libre (en granules) pour les disquettes 
connectées 
(1 granule = 1024 octets) 


FORMAT 


formatte une disquette 
a) frapper FORMAT et suivre les instructions 
b) frapper directement : FORMAT numéro lecteur,MM/JJ/AA, 


mot de passe 
KILL nom de fichier 


supprime un fichier 


KILL XX:1 supprime le fichier XX sur lecteur 1 


RENAME ancien nom TO nouveau nom 


RENAME XX TO YY le fichier XX devient le fichier YY 


BASIC 
permet de travailler avec le système BASIC 


1) BASIC connecte sous BASIC 


2) BASIC # connecte sous BASIC avec le contenu de la 
mémoire au moment où BASIC a été quitté 
(par CMD "S") 


3) BASIC commande BASIC 
BASIC RUN "FACTU/BAS" 
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COMMANDES ESSENTIELLES SOUS BASIC DU D.0.S. TRS-80 


(Ces commandes peuvent aussi être utilisées comme instructions BASIC) 


LOAD "nom programme" 
charge le programme spécifié en mémoire centrale 


LOAD "FACTU/BAS" charge le programme FACTU/BAS 


RUN 
exécute le programme en mémoire centrale 
RUN "FACTU/BAS" charge puis exécute le programme FACTU/BAS 
RUN "FACTU/BAS",R charge et exécute FACTU/BAS mais ne clot 
pas les fichiers déjà ouverts 
KILL "nom de fichier" 


supprime le fichier spécifié (qui doit être clos) 


MERGE "nom de programme" 
concatène le programme spécifié (sauvegardé en ASCII) 
au programme en mémoire centrale 
RENUM nouveau numéro de ligne, incrément, numéro départ, 
numéro fin 
renumérote un programme 
RENUM 100 renumérote à partir de 100 de 10 en 10 


RENUM 100,5 renumérote à partir de 100 de 5 en 5 


REF 

1/ REF % 
fournit la liste à l'écran des références de toutes les 
variables 

2/ REF $ 


imprime la liste des références de toutes les variables 


3/ REF variable 
affiche à l'écran les références de la variable spécifiée 
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4/ REF # variable 


affiche à l'écran les références des variables à partir 
de la variable spécifiée 


5/ REF $ variable 
imprime les références des variables à partir de la 


variable spécifiée 
SAVE 


SAVE "FACTU/BAS" sauvegarde le programme en mémoire 
sous le nom de FACTU/BAS 


SAVE "FACTU/TXT",A sauvegarde le programme sous forme ASCII 


CMD 
Sous BASIC, permet d'accéder aux commandes D.0.S. 
CMD "DIR" fournit la liste des programmes 


CMD "S" retour au D.0.S. 


DIRCHECK 


fournit la liste des fichiers sur l'écran ou l'imprimante 
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LE BASIC ET SES FICHIERS 


ANNEXE L'T,.I 


QUELQUES COMMANDES CPM 


DIR 
>DIR A: 
fournit la liste des programmes sur la disquette du lecteur À 
STAT 


> STAT 
fournit l'espace disque de l'unité A 


>STAT B: 
fournit l'espace disque de l'unité B 


2STAT B:%.BAS 


fournit la liste des programmes BASIC 


PIP 
#Æ— 
2PIP A:PAYE.BAS=B:PAIE.BAS 
copie le programme PAIE de l'unité B sur l'unité A sous 
le nom de PAYE 


8 — 
2PIP B:A:%#.% 
copie tous les fichiers de À sur B 


2 
>PIP B:=#.COM 
copie toutes les commandes de l'unité À sur l'unité B 


>PIP <retour chariot} 
XB:=A:#.X% transfère tous les fichiers de À sur B 


#éretour chariot» 


ERA 
2 ERA A:PAYE.BAS 
efface le programme PAYE 
REN 


DREN PAYE.BAS=PAIE.BAS 
PAIE devient PAYE 
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